diff --git a/.nuget/NuGet.Config b/.nuget/NuGet.Config index 74cfeb0b4a1..748f1076f6e 100644 --- a/.nuget/NuGet.Config +++ b/.nuget/NuGet.Config @@ -4,11 +4,13 @@ + - + + diff --git a/BuildToolsVersion.txt b/BuildToolsVersion.txt index 183e149f4c5..7a2bca562e7 100644 --- a/BuildToolsVersion.txt +++ b/BuildToolsVersion.txt @@ -1 +1 @@ -1.0.25-prerelease-00404-01 +1.0.25-prerelease-00517-05 diff --git a/DEVGUIDE.md b/DEVGUIDE.md index cb88da6805c..d81788c893d 100644 --- a/DEVGUIDE.md +++ b/DEVGUIDE.md @@ -50,6 +50,10 @@ There are various qualifiers: build.cmd test-fsharpqa -- build, run tests\fsharpqa suite build.cmd test-vs -- build, run Visual F# IDE Tools unit tests +**Notes** +To build and test Visual F# IDE Tools, you must use [Visual Studio "vNext" (aka "Dev15")](https://www.visualstudio.com/en-us/downloads/visual-studio-next-downloads-vs.aspx). This is the one after Visual Studio 2015 (aka "Dev 14"). You must also install Visual Studio SDK (also called _Visual Studio Extensibility SDK_ on the Visual Studio installer) before building Visual F# IDE Tools. +Please ensure that the Visual Studio SDK version is matched with your current Visual Studio to ensure successful builds. For example: Visual Studio 2015 Update 1 requires Visual Studio 2015 SDK Update 1. Any installation of Visual Studio 2015 and later provides Visual Studio SDK as part of the installation of Visual Studio 2015 as feature installation. + Combinations are also allowed: build.cmd debug,compiler,notests -- build the debug compiler and run smoke tests @@ -147,8 +151,13 @@ For **Release** this corresponds to these steps, which you can run individually ### 4. [Optional] Install the Visual F# IDE Tools -**Note:** This step will install a VSIX extension into Visual Studio 15 that changes the Visual F# IDE Tools -components installed into Visual Studio 15. You can revert this step by disabling or uninstalling the addin. +At time of writing, the Visual F# IDE Tools can only be installed into Visual Studio "Next" (aka "Dev15") releases. +The new builds of the Visual F# IDE Tools can no longer be installed into Visual Studio 2015. + +You can install VIsual Studio "Next (aka "Dev15") from https://www.visualstudio.com/en-us/downloads/visual-studio-next-downloads-vs.aspx. + +**Note:** This step will install a VSIX extension into Visual Studio "Next" (aka "Dev15") that changes the Visual F# IDE Tools +components installed in that VS installation. You can revert this step by disabling or uninstalling the addin. For **Debug**: diff --git a/DotnetCLIVersion.txt b/DotnetCLIVersion.txt index cbe430cd616..637c64f4b15 100644 --- a/DotnetCLIVersion.txt +++ b/DotnetCLIVersion.txt @@ -1 +1 @@ -1.0.0-rc2-002665 \ No newline at end of file +1.0.0-preview2-003121 \ No newline at end of file diff --git a/README.md b/README.md index 011a1baca55..8f0751d9af5 100644 --- a/README.md +++ b/README.md @@ -8,7 +8,7 @@ | |Debug (Build only)|Release (Tests Part 1)|Release (Tests Part 2)| |:----------:|:----------------:|:------------------:|:-----------------------:| |**master** |[![Build Status](http://dotnet-ci.cloudapp.net/buildStatus/icon?job=Microsoft_visualfsharp/master/debug_windows_nt)](http://dotnet-ci.cloudapp.net/job/Microsoft_visualfsharp/job/master/job/debug_windows_nt/)|[![Build Status](http://dotnet-ci.cloudapp.net/buildStatus/icon?job=Microsoft_visualfsharp/master/release_ci_part1_windows_nt)](http://dotnet-ci.cloudapp.net/job/Microsoft_visualfsharp/job/master/job/release_ci_part1_windows_nt/)|[![Build Status](http://dotnet-ci.cloudapp.net/buildStatus/icon?job=Microsoft_visualfsharp/master/release_ci_part2_windows_nt)](http://dotnet-ci.cloudapp.net/job/Microsoft_visualfsharp/job/master/job/release_ci_part2_windows_nt/)| -|**roslyn** |[![Build Status](http://dotnet-ci.cloudapp.net/buildStatus/icon?job=Microsoft_visualfsharp/roslyn/debug_windows_nt)](http://dotnet-ci.cloudapp.net/job/Microsoft_visualfsharp/job/roslyn/job/debug_windows_nt/)|[![Build Status](http://dotnet-ci.cloudapp.net/buildStatus/icon?job=Microsoft_visualfsharp/roslyn/release_ci_part1_windows_nt)](http://dotnet-ci.cloudapp.net/job/Microsoft_visualfsharp/job/roslyn/job/release_ci_part1_windows_nt/)|[![Build Status](http://dotnet-ci.cloudapp.net/buildStatus/icon?job=Microsoft_visualfsharp/roslyn/release_ci_part2_windows_nt)](http://dotnet-ci.cloudapp.net/job/Microsoft_visualfsharp/job/roslyn/job/release_ci_part2_windows_nt/)| +|**roslyn** |[![Build Status](http://dotnet-ci.cloudapp.net/buildStatus/icon?job=Microsoft_visualfsharp/roslyn/debug_windows_nt)](http://dotnet-ci.cloudapp.net/job/Microsoft_visualfsharp/job/roslyn/job/debug_windows_nt/)|[![Build Status](http://dotnet-ci.cloudapp.net/buildStatus/icon?job=Microsoft_visualfsharp/roslyn/release_ci_part1_windows_nt)](http://dotnet-ci.cloudapp.net/job/Microsoft_visualfsharp/job/roslyn/job/release_ci_part1_windows_nt/)|[![Build Status](http://dotnet-ci.cloudapp.net/buildStatus/icon?job=Microsoft_visualfsharp/roslyn/release_ci_part2_windows_nt)](http://dotnet-ci.cloudapp.net/job/Microsoft_visualfsharp/job/roslyn/job/release_ci_part2_windows_nt/)| ###Contributing to the F# Language, Library, and Tools @@ -60,7 +60,7 @@ For F# 4.1 development - [.NET 3.5](http://www.microsoft.com/en-us/download/details.aspx?id=21) - [.NET 4.5](http://www.microsoft.com/en-us/download/details.aspx?id=30653) - [.NET 4.5.1](http://www.microsoft.com/en-us/download/details.aspx?id=40779) -- [.NET 4.6](https://www.microsoft.com/en-us/download/details.aspx?id=48137) +- [.NET 4.6](http://www.microsoft.com/en-us/download/details.aspx?id=48137) - [MSBuild 12.0](http://www.microsoft.com/en-us/download/details.aspx?id=40760) - [Windows 7 SDK](http://www.microsoft.com/en-us/download/details.aspx?id=8279) - [Windows 8 SDK](http://msdn.microsoft.com/en-us/windows/desktop/hh852363.aspx) @@ -94,4 +94,3 @@ Although the primary focus of this repo is F# for Windows and the Visual Studio Keep up with the Visual F# Team and the development of the Visual F# Tools by following us [@VisualFSharp](https://twitter.com/VisualFSharp) or subscribing to our [team blog](http://blogs.msdn.com/b/fsharpteam/). - diff --git a/VisualFSharp.sln b/VisualFSharp.sln index 99d03d490e0..510cf7db4c0 100644 --- a/VisualFSharp.sln +++ b/VisualFSharp.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 15 -VisualStudioVersion = 15.0.25123.0 +VisualStudioVersion = 15.0.25302.0 MinimumVisualStudioVersion = 10.0.40219.1 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler", "src\fsharp\FSharp.Compiler\FSharp.Compiler.fsproj", "{2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}" EndProject @@ -118,7 +118,18 @@ Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "TextFile", "vsintegration\I EndProject Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "XMLFile", "vsintegration\ItemTemplates\XMLFile\XMLFile.csproj", "{1FB1DD07-06AA-45B4-B5AC-20FF5BEE98B6}" EndProject -Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "VisualFSharpVsix", "vsintegration\VisualFSharpVsix\VisualFSharpVsix.csproj", "{E7EC4A3E-9D57-45B8-83F5-EDDFD6CEF090}" +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{A83A9A70-8C33-4253-BF6F-3AADB509F21C}" + ProjectSection(SolutionItems) = preProject + Performance1.psess = Performance1.psess + EndProjectSection +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Vsix", "Vsix", "{141F6C23-E1B1-4D89-9F10-F0B8AD58E71F}" +EndProject +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "VisualFSharpDesktop", "vsintegration\Vsix\VisualFSharpDesktop\VisualFSharpDesktop.csproj", "{E7EC4A3E-9D57-45B8-83F5-EDDFD6CEF090}" +EndProject +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "VisualFSharpFull", "vsintegration\Vsix\VisualFSharpFull\VisualFSharpFull.csproj", "{59ADCE46-9740-4079-834D-9A03A3494EBC}" +EndProject +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "VisualFSharpWeb", "vsintegration\Vsix\VisualFSharpWeb\VisualFSharpWeb.csproj", "{58730C8B-16F5-4956-9291-BB68E17C9142}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution @@ -705,6 +716,30 @@ Global {E7EC4A3E-9D57-45B8-83F5-EDDFD6CEF090}.Release|Any CPU.Build.0 = Release|Any CPU {E7EC4A3E-9D57-45B8-83F5-EDDFD6CEF090}.Release|x86.ActiveCfg = Release|Any CPU {E7EC4A3E-9D57-45B8-83F5-EDDFD6CEF090}.Release|x86.Build.0 = Release|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Debug|Any CPU.Build.0 = Debug|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Debug|x86.ActiveCfg = Debug|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Debug|x86.Build.0 = Debug|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Proto|Any CPU.ActiveCfg = Proto|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Proto|Any CPU.Build.0 = Proto|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Proto|x86.ActiveCfg = Proto|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Proto|x86.Build.0 = Proto|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Release|Any CPU.ActiveCfg = Release|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Release|Any CPU.Build.0 = Release|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Release|x86.ActiveCfg = Release|Any CPU + {59ADCE46-9740-4079-834D-9A03A3494EBC}.Release|x86.Build.0 = Release|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Debug|Any CPU.Build.0 = Debug|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Debug|x86.ActiveCfg = Debug|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Debug|x86.Build.0 = Debug|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Proto|Any CPU.ActiveCfg = Proto|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Proto|Any CPU.Build.0 = Proto|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Proto|x86.ActiveCfg = Proto|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Proto|x86.Build.0 = Proto|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Release|Any CPU.ActiveCfg = Release|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Release|Any CPU.Build.0 = Release|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Release|x86.ActiveCfg = Release|Any CPU + {58730C8B-16F5-4956-9291-BB68E17C9142}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -761,6 +796,9 @@ Global {E3FDD4AC-46B6-4B9F-B672-317D1202CC50} = {F6DAEE9A-8BE1-4C4A-BC83-09215517C7DA} {D11FC318-8F5D-4C8C-9287-AB40A016D13C} = {F6DAEE9A-8BE1-4C4A-BC83-09215517C7DA} {1FB1DD07-06AA-45B4-B5AC-20FF5BEE98B6} = {F6DAEE9A-8BE1-4C4A-BC83-09215517C7DA} - {E7EC4A3E-9D57-45B8-83F5-EDDFD6CEF090} = {4C7B48D7-19AF-4AE7-9D1D-3BB289D5480D} + {141F6C23-E1B1-4D89-9F10-F0B8AD58E71F} = {4C7B48D7-19AF-4AE7-9D1D-3BB289D5480D} + {E7EC4A3E-9D57-45B8-83F5-EDDFD6CEF090} = {141F6C23-E1B1-4D89-9F10-F0B8AD58E71F} + {59ADCE46-9740-4079-834D-9A03A3494EBC} = {141F6C23-E1B1-4D89-9F10-F0B8AD58E71F} + {58730C8B-16F5-4956-9291-BB68E17C9142} = {141F6C23-E1B1-4D89-9F10-F0B8AD58E71F} EndGlobalSection EndGlobal diff --git a/appveyor.yml b/appveyor.yml index 87ae05705b1..a2a47d401a3 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -1,5 +1,5 @@ os: Visual Studio 2015 - + environment: matrix: - BUILD_PROFILE: ci_part1 diff --git a/build.cmd b/build.cmd index 92765e2554f..26434b5ad34 100644 --- a/build.cmd +++ b/build.cmd @@ -141,7 +141,8 @@ if /i '%ARG%' == 'ci' ( set CONF_FSHARPQA_SUITE=Smoke ) -REM These divide 'ci' into three chunks which can be done in parallel + +REM These divide 'ci' into two chunks which can be done in parallel if /i '%ARG%' == 'ci_part1' ( set BUILD_PROTO=1 set SKIP_EXPENSIVE_TESTS=1 @@ -338,20 +339,20 @@ pushd .\lkg & %_dotnetexe% publish project.json &popd @if ERRORLEVEL 1 echo Error: dotnet publish failed && goto :failure rem rename fsc and coreconsole to allow fsc.exe to to start compiler -pushd .\lkg\bin\debug\dnxcore50\win7-x64\publish -fc fsc.exe corehost.exe >nul +pushd .\lkg\bin\debug\netstandard1.6\win7-x64\publish +fc fsc.exe dotnet.exe >nul @if ERRORLEVEL 1 ( copy fsc.exe fsc.dll - copy corehost.exe fsc.exe + copy dotnet.exe fsc.exe ) popd rem rename fsc and coreconsole to allow fsc.exe to to start compiler -pushd .\lkg\bin\debug\dnxcore50\win7-x64\publish -fc fsi.exe corehost.exe >nul +pushd .\lkg\bin\debug\netstandard1.6\win7-x64\publish +fc fsi.exe dotnet.exe >nul @if ERRORLEVEL 1 ( copy fsi.exe fsi.dll - copy corehost.exe fsi.exe + copy dotnet.exe fsi.exe ) popd diff --git a/init-tools.cmd b/init-tools.cmd index d48ff4d1248..13d61e8ea4c 100644 --- a/init-tools.cmd +++ b/init-tools.cmd @@ -7,11 +7,11 @@ if [%TOOLRUNTIME_DIR%]==[] set TOOLRUNTIME_DIR=%~dp0Tools set DOTNET_PATH=%TOOLRUNTIME_DIR%\dotnetcli\ if [%DOTNET_CMD%]==[] set DOTNET_CMD=%DOTNET_PATH%dotnet.exe if [%BUILDTOOLS_SOURCE%]==[] set BUILDTOOLS_SOURCE=https://dotnet.myget.org/F/dotnet-buildtools/api/v3/index.json -set /P BUILDTOOLS_VERSION=< %~dp0BuildToolsVersion.txt +set /P BUILDTOOLS_VERSION=< "%~dp0BuildToolsVersion.txt" set BUILD_TOOLS_PATH=%PACKAGES_DIR%Microsoft.DotNet.BuildTools\%BUILDTOOLS_VERSION%\lib\ set PROJECT_JSON_PATH=%TOOLRUNTIME_DIR%\%BUILDTOOLS_VERSION% set PROJECT_JSON_FILE=%PROJECT_JSON_PATH%\project.json -set PROJECT_JSON_CONTENTS={ "dependencies": { "Microsoft.DotNet.BuildTools": "%BUILDTOOLS_VERSION%" }, "frameworks": { "dnxcore50": { } } } +set PROJECT_JSON_CONTENTS={ "dependencies": { "Microsoft.DotNet.BuildTools": "%BUILDTOOLS_VERSION%" }, "frameworks": { "netcoreapp1.0": { } } } set BUILD_TOOLS_SEMAPHORE=%PROJECT_JSON_PATH%\init-tools.completed :: if force option is specified then clean the tool runtime and build tools package directory to force it to get recreated @@ -29,40 +29,45 @@ if exist "%BUILD_TOOLS_SEMAPHORE%" ( if exist "%TOOLRUNTIME_DIR%" rmdir /S /Q "%TOOLRUNTIME_DIR%" if NOT exist "%PROJECT_JSON_PATH%" mkdir "%PROJECT_JSON_PATH%" -echo %PROJECT_JSON_CONTENTS% > %PROJECT_JSON_FILE% -echo Running %0 > %INIT_TOOLS_LOG% +echo %PROJECT_JSON_CONTENTS% > "%PROJECT_JSON_FILE%" +echo Running %0 > "%INIT_TOOLS_LOG%" if exist "%DOTNET_CMD%" goto :afterdotnetrestore echo Installing dotnet cli... if NOT exist "%DOTNET_PATH%" mkdir "%DOTNET_PATH%" -set /p DOTNET_VERSION=< %~dp0DotnetCLIVersion.txt +set /p DOTNET_VERSION=< "%~dp0DotnetCLIVersion.txt" set DOTNET_ZIP_NAME=dotnet-dev-win-x64.%DOTNET_VERSION%.zip -set DOTNET_REMOTE_PATH=https://dotnetcli.blob.core.windows.net/dotnet/beta/Binaries/%DOTNET_VERSION%/%DOTNET_ZIP_NAME% +set DOTNET_REMOTE_PATH=https://dotnetcli.blob.core.windows.net/dotnet/preview/Binaries/%DOTNET_VERSION%/%DOTNET_ZIP_NAME% set DOTNET_LOCAL_PATH=%DOTNET_PATH%%DOTNET_ZIP_NAME% -echo Installing '%DOTNET_REMOTE_PATH%' to '%DOTNET_LOCAL_PATH%' >> %INIT_TOOLS_LOG% -powershell -NoProfile -ExecutionPolicy unrestricted -Command "(New-Object Net.WebClient).DownloadFile('%DOTNET_REMOTE_PATH%', '%DOTNET_LOCAL_PATH%'); Add-Type -Assembly 'System.IO.Compression.FileSystem' -ErrorVariable AddTypeErrors; if ($AddTypeErrors.Count -eq 0) { [System.IO.Compression.ZipFile]::ExtractToDirectory('%DOTNET_LOCAL_PATH%', '%DOTNET_PATH%') } else { (New-Object -com shell.application).namespace('%DOTNET_PATH%').CopyHere((new-object -com shell.application).namespace('%DOTNET_LOCAL_PATH%').Items(),16) }" >> %INIT_TOOLS_LOG% +echo Installing '%DOTNET_REMOTE_PATH%' to '%DOTNET_LOCAL_PATH%' >> "%INIT_TOOLS_LOG%" +powershell -NoProfile -ExecutionPolicy unrestricted -Command "$retryCount = 0; $success = $false; do { try { (New-Object Net.WebClient).DownloadFile('%DOTNET_REMOTE_PATH%', '%DOTNET_LOCAL_PATH%'); $success = $true; } catch { if ($retryCount -ge 6) { throw; } else { $retryCount++; Start-Sleep -Seconds (5 * $retryCount); } } } while ($success -eq $false); Add-Type -Assembly 'System.IO.Compression.FileSystem' -ErrorVariable AddTypeErrors; if ($AddTypeErrors.Count -eq 0) { [System.IO.Compression.ZipFile]::ExtractToDirectory('%DOTNET_LOCAL_PATH%', '%DOTNET_PATH%') } else { (New-Object -com shell.application).namespace('%DOTNET_PATH%').CopyHere((new-object -com shell.application).namespace('%DOTNET_LOCAL_PATH%').Items(),16) }" >> "%INIT_TOOLS_LOG%" if NOT exist "%DOTNET_LOCAL_PATH%" ( echo ERROR: Could not install dotnet cli correctly. See '%INIT_TOOLS_LOG%' for more details. - goto :EOF + exit /b 1 ) :afterdotnetrestore if exist "%BUILD_TOOLS_PATH%" goto :afterbuildtoolsrestore echo Restoring BuildTools version %BUILDTOOLS_VERSION%... -echo Running: "%DOTNET_CMD%" restore "%PROJECT_JSON_FILE%" --packages %PACKAGES_DIR% --source "%BUILDTOOLS_SOURCE%" >> %INIT_TOOLS_LOG% -call "%DOTNET_CMD%" restore "%PROJECT_JSON_FILE%" --packages %PACKAGES_DIR% --source "%BUILDTOOLS_SOURCE%" >> %INIT_TOOLS_LOG% +echo Running: "%DOTNET_CMD%" restore "%PROJECT_JSON_FILE%" --packages %PACKAGES_DIR% --source "%BUILDTOOLS_SOURCE%" >> "%INIT_TOOLS_LOG%" +call "%DOTNET_CMD%" restore "%PROJECT_JSON_FILE%" --packages %PACKAGES_DIR% --source "%BUILDTOOLS_SOURCE%" >> "%INIT_TOOLS_LOG%" if NOT exist "%BUILD_TOOLS_PATH%init-tools.cmd" ( echo ERROR: Could not restore build tools correctly. See '%INIT_TOOLS_LOG%' for more details. - goto :EOF + exit /b 1 ) :afterbuildtoolsrestore echo Initializing BuildTools ... -echo Running: "%BUILD_TOOLS_PATH%init-tools.cmd" "%~dp0" "%DOTNET_CMD%" "%TOOLRUNTIME_DIR%" >> %INIT_TOOLS_LOG% -call "%BUILD_TOOLS_PATH%init-tools.cmd" "%~dp0" "%DOTNET_CMD%" "%TOOLRUNTIME_DIR%" >> %INIT_TOOLS_LOG% +echo Running: "%BUILD_TOOLS_PATH%init-tools.cmd" "%~dp0" "%DOTNET_CMD%" "%TOOLRUNTIME_DIR%" >> "%INIT_TOOLS_LOG%" +call "%BUILD_TOOLS_PATH%init-tools.cmd" "%~dp0" "%DOTNET_CMD%" "%TOOLRUNTIME_DIR%" >> "%INIT_TOOLS_LOG%" +set INIT_TOOLS_ERRORLEVEL=%ERRORLEVEL% +if not [%INIT_TOOLS_ERRORLEVEL%]==[0] ( + echo ERROR: An error occured when trying to initialize the tools. Please check '%INIT_TOOLS_LOG%' for more details. + exit /b %INIT_TOOLS_ERRORLEVEL% +) :: Create sempahore file echo Done initializing tools. diff --git a/init-tools.sh b/init-tools.sh index 033a652cde5..57564e7827a 100644 --- a/init-tools.sh +++ b/init-tools.sh @@ -12,7 +12,7 @@ __DOTNET_TOOLS_VERSION=$(cat $__scriptpath/DotnetCLIVersion.txt) __BUILD_TOOLS_PATH=$__PACKAGES_DIR/Microsoft.DotNet.BuildTools/$__BUILD_TOOLS_PACKAGE_VERSION/lib __PROJECT_JSON_PATH=$__TOOLRUNTIME_DIR/$__BUILD_TOOLS_PACKAGE_VERSION __PROJECT_JSON_FILE=$__PROJECT_JSON_PATH/project.json -__PROJECT_JSON_CONTENTS="{ \"dependencies\": { \"Microsoft.DotNet.BuildTools\": \"$__BUILD_TOOLS_PACKAGE_VERSION\" }, \"frameworks\": { \"dnxcore50\": { } } }" +__PROJECT_JSON_CONTENTS="{ \"dependencies\": { \"Microsoft.DotNet.BuildTools\": \"$__BUILD_TOOLS_PACKAGE_VERSION\" }, \"frameworks\": { \"netcoreapp1.0\": { } } }" OSName=$(uname -s) case $OSName in @@ -24,14 +24,12 @@ case $OSName in Linux) OS=Linux - source /etc/os-release - if [ "$ID" == "centos" -o "$ID" == "rhel" ]; then - __DOTNET_PKG=dotnet-dev-centos-x64 - elif [ "$ID" == "ubuntu" -o "$ID" == "debian" ]; then - __DOTNET_PKG=dotnet-dev-ubuntu-x64 + if [ ! -e /etc/os-release ]; then + echo "Cannot determine Linux distribution, asuming Ubuntu 14.04." + __DOTNET_PKG=dotnet-dev-ubuntu.14.04-x64 else - echo "Unsupported Linux distribution '$ID' detected. Downloading ubuntu-x64 tools." - __DOTNET_PKG=dotnet-dev-ubuntu-x64 + source /etc/os-release + __DOTNET_PKG="dotnet-dev-$ID.$VERSION_ID-x64" fi ;; @@ -47,7 +45,7 @@ if [ ! -e $__PROJECT_JSON_FILE ]; then echo "Running: $__scriptpath/init-tools.sh" > $__init_tools_log if [ ! -e $__DOTNET_PATH ]; then echo "Installing dotnet cli..." - __DOTNET_LOCATION="https://dotnetcli.blob.core.windows.net/dotnet/beta/Binaries/${__DOTNET_TOOLS_VERSION}/${__DOTNET_PKG}.${__DOTNET_TOOLS_VERSION}.tar.gz" + __DOTNET_LOCATION="https://dotnetcli.blob.core.windows.net/dotnet/preview/Binaries/${__DOTNET_TOOLS_VERSION}/${__DOTNET_PKG}.${__DOTNET_TOOLS_VERSION}.tar.gz" # curl has HTTPS CA trust-issues less often than wget, so lets try that first. echo "Installing '${__DOTNET_LOCATION}' to '$__DOTNET_PATH/dotnet.tar'" >> $__init_tools_log which curl > /dev/null 2> /dev/null @@ -55,16 +53,10 @@ if [ ! -e $__PROJECT_JSON_FILE ]; then mkdir -p "$__DOTNET_PATH" wget -q -O $__DOTNET_PATH/dotnet.tar ${__DOTNET_LOCATION} else - curl -sSL --create-dirs -o $__DOTNET_PATH/dotnet.tar ${__DOTNET_LOCATION} + curl --retry 10 -sSL --create-dirs -o $__DOTNET_PATH/dotnet.tar ${__DOTNET_LOCATION} fi cd $__DOTNET_PATH tar -xf $__DOTNET_PATH/dotnet.tar - if [ -n "$BUILDTOOLS_OVERRIDE_RUNTIME" ]; then - find $__DOTNET_PATH -name *.ni.* | xargs rm 2>/dev/null - cp -R $BUILDTOOLS_OVERRIDE_RUNTIME/* $__DOTNET_PATH/bin - cp -R $BUILDTOOLS_OVERRIDE_RUNTIME/* $__DOTNET_PATH/bin/dnx - cp -R $BUILDTOOLS_OVERRIDE_RUNTIME/* $__DOTNET_PATH/runtime/coreclr - fi cd $__scriptpath fi @@ -82,6 +74,10 @@ if [ ! -e $__PROJECT_JSON_FILE ]; then echo "Initializing BuildTools..." echo "Running: $__BUILD_TOOLS_PATH/init-tools.sh $__scriptpath $__DOTNET_CMD $__TOOLRUNTIME_DIR" >> $__init_tools_log $__BUILD_TOOLS_PATH/init-tools.sh $__scriptpath $__DOTNET_CMD $__TOOLRUNTIME_DIR >> $__init_tools_log + if [ "$?" != "0" ]; then + echo "ERROR: An error occured when trying to initialize the tools. Please check '$__init_tools_log' for more details." + exit 1 + fi echo "Done initializing tools." else echo "Tools are already initialized" diff --git a/lkg/project.json b/lkg/project.json index 0cdec322199..9d27bf4a78e 100644 --- a/lkg/project.json +++ b/lkg/project.json @@ -1,6 +1,10 @@ + { "dependencies": { - "Microsoft.FSharp.Compiler.Host.netcore": "1.0.0-alpha-160406", + "Microsoft.FSharp.Compiler.Host.netcore": "1.0.0-alpha-160629", + "Microsoft.NETCore.Runtime.CoreCLR": "1.0.2", + "Microsoft.NETCore.DotNetHostPolicy": "1.0.1", + "Microsoft.NETCore.DotNetHost": "1.0.1" }, "runtimes": { "win7-x86": { }, @@ -9,7 +13,7 @@ "ubuntu.14.04-x64": { } }, "frameworks": { - "dnxcore50": { + "netstandard1.6": { "imports": "portable-net45+win8" } } diff --git a/packages.config b/packages.config index d20b53a4e20..f34b13d5016 100644 --- a/packages.config +++ b/packages.config @@ -5,35 +5,39 @@ - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/setup/FSharp.SDK/Common.Wix.Properties.wxs b/setup/FSharp.SDK/Common.Wix.Properties.wxs index 65166a349dd..6f947532403 100644 --- a/setup/FSharp.SDK/Common.Wix.Properties.wxs +++ b/setup/FSharp.SDK/Common.Wix.Properties.wxs @@ -2,12 +2,6 @@ - - - - - - @@ -18,64 +12,64 @@ - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + @@ -86,12 +80,14 @@ - + + + - + diff --git a/setup/FSharp.SDK/FSharp.SDK.wixproj b/setup/FSharp.SDK/FSharp.SDK.wixproj index 668e4592800..3814288bc8c 100644 --- a/setup/FSharp.SDK/FSharp.SDK.wixproj +++ b/setup/FSharp.SDK/FSharp.SDK.wixproj @@ -10,7 +10,7 @@ - FSharp.SDK + Microsoft.FSharp.SDK da0da41f-0e00-4598-8eee-b29d31b0ca04 Package net @@ -21,11 +21,14 @@ - $(DefineConstants);Lang=$(Lang) + $(DefineConstants);LocaleCode=$(LocaleCode) + $(DefineConstants);LocaleId=$(LocaleId) + $(DefineConstants);LocaleRegion=$(LocaleRegion) + $(DefineConstants);IsLangPack=$(IsLangPack) + $(DefineConstants);BinariesDir=$(BinariesDir) $(DefineConstants);FSharpTreeRoot=$(FSharpTreeRoot) - $(DefineConstants);FSharpCoreRedistDir=$(FSharpCoreRedistDir) - $(DefineConstants);FSharpTypeProvidersRedistDir=$(FSharpTypeProvidersRedistDir) + $(DefineConstants);NugetPackagesDir=$(NugetPackagesDir) @@ -43,10 +46,11 @@ - - - - + + + + + @@ -58,8 +62,11 @@ - - + + + + + @@ -67,6 +74,6 @@ - + \ No newline at end of file diff --git a/setup/FSharp.SDK/FSharp.SDK.wxs b/setup/FSharp.SDK/FSharp.SDK.wxs index 4967656f0bf..ca798e15ff6 100644 --- a/setup/FSharp.SDK/FSharp.SDK.wxs +++ b/setup/FSharp.SDK/FSharp.SDK.wxs @@ -6,37 +6,36 @@ - + - + - - - - - - - + + + + + - - + + + + + \ No newline at end of file diff --git a/setup/FSharp.SDK/component-groups/Compiler_LangPack.wxs b/setup/FSharp.SDK/component-groups/Compiler_LangPack.wxs new file mode 100644 index 00000000000..82e467a8dc4 --- /dev/null +++ b/setup/FSharp.SDK/component-groups/Compiler_LangPack.wxs @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/setup/FSharp.SDK/component-groups/Compiler_OtherResources.wxs b/setup/FSharp.SDK/component-groups/Compiler_OtherResources.wxs deleted file mode 100644 index 20fad81b1d1..00000000000 --- a/setup/FSharp.SDK/component-groups/Compiler_OtherResources.wxs +++ /dev/null @@ -1,32 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs b/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs new file mode 100644 index 00000000000..9621c76c106 --- /dev/null +++ b/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs @@ -0,0 +1,161 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/setup/FSharp.SDK/component-groups/Compiler_SDK.wxs b/setup/FSharp.SDK/component-groups/Compiler_SDK.wxs deleted file mode 100644 index 0c3ca0f90e8..00000000000 --- a/setup/FSharp.SDK/component-groups/Compiler_SDK.wxs +++ /dev/null @@ -1,144 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/setup/FSharp.SDK/component-groups/Langpack_ManagedFiles.wxs b/setup/FSharp.SDK/component-groups/Langpack_ManagedFiles.wxs deleted file mode 100644 index 756e492a514..00000000000 --- a/setup/FSharp.SDK/component-groups/Langpack_ManagedFiles.wxs +++ /dev/null @@ -1,171 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/setup/FSharp.SDK/component-groups/Redist_ManagedFiles.wxs b/setup/FSharp.SDK/component-groups/Redist_ManagedFiles.wxs deleted file mode 100644 index 73e8b104e7e..00000000000 --- a/setup/FSharp.SDK/component-groups/Redist_ManagedFiles.wxs +++ /dev/null @@ -1,187 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/setup/FSharp.SDK/component-groups/Runtime_LangPack.wxs b/setup/FSharp.SDK/component-groups/Runtime_LangPack.wxs new file mode 100644 index 00000000000..8dc3c0d6bc9 --- /dev/null +++ b/setup/FSharp.SDK/component-groups/Runtime_LangPack.wxs @@ -0,0 +1,166 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/setup/FSharp.SDK/component-groups/Runtime_Redist.wxs b/setup/FSharp.SDK/component-groups/Runtime_Redist.wxs new file mode 100644 index 00000000000..89d5a7fdc8f --- /dev/null +++ b/setup/FSharp.SDK/component-groups/Runtime_Redist.wxs @@ -0,0 +1,183 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/setup/FSharp.Setup.props b/setup/FSharp.Setup.props index ea36f75549e..683a8929c52 100644 --- a/setup/FSharp.Setup.props +++ b/setup/FSharp.Setup.props @@ -1,23 +1,112 @@ - - 2.0 - 3.10 - 3.10.0.1503 - $(SetupRootFolder)\..\packages\WiX.Toolset.2015.$(WiXToolset2015Version)\tools\wix - $(SetupRootFolder)\..\packages\Microsoft.VisualFSharp.Core.Redist.1.0.0 - $(SetupRootFolder)\..\packages\Microsoft.VisualFSharp.Type.Providers.Redist.1.0.0 - - - net40 - Debug - AnyCPU - - - $(SetupRootFolder)\..\$(Configuration) - obj\$(Configuration)\ - $(BinariesDir)\setup - $(BinariesDir)\setup\$(Lang) - + + 2.0 + 3.10 + 3.10.0.1503 + $(SetupRootFolder)\..\packages\WiX.Toolset.2015.$(WiXToolset2015Version)\tools\wix + $(SetupRootFolder)\..\packages + + + + net40 + Debug + AnyCPU + + + + $(SetupRootFolder)\..\$(Configuration) + obj\$(Configuration)\ + $(BinariesDir)\setup + $(BinariesDir)\setup\$(Lang) + + + + + ENU + 1033 + en-us + false + + + CHT + 1028 + zh-tw + true + + + CSY + 1029 + cs-cz + true + + + DEU + 1031 + de-de + true + + + FRA + 1036 + fr-fr + true + + + ITA + 1040 + it-it + true + + + JPN + 1041 + ja-jp + true + + + KOR + 1042 + ko-kr + true + + + PLK + 1045 + pl-pl + true + + + PTB + 1046 + pt-br + true + + + RUS + 1049 + ru-ru + true + + + TRK + 1055 + tr-tr + true + + + CHS + 2052 + zh-cn + true + + + ESN + 3082 + es-es + true + + + diff --git a/setup/FSharp.Wix.Extensions/FSharpPreprocessorExtension.cs b/setup/FSharp.Wix.Extensions/FSharpPreprocessorExtension.cs index 27e7663be5a..d6736218edc 100644 --- a/setup/FSharp.Wix.Extensions/FSharpPreprocessorExtension.cs +++ b/setup/FSharp.Wix.Extensions/FSharpPreprocessorExtension.cs @@ -14,24 +14,6 @@ public class FSharpPreprocessorExtension : PreprocessorExtension { private readonly string[] prefixes = new string[] { "fsharp" }; - private readonly List supportedLanguages = new List() - { - new CultureInfo(1028), // CHT - new CultureInfo(1029), // CSY - new CultureInfo(1031), // DEU - new CultureInfo(1033), // ENU - new CultureInfo(1036), // FRA - new CultureInfo(1040), // ITA - new CultureInfo(1041), // JPN - new CultureInfo(1042), // KOR - new CultureInfo(1045), // PLK - new CultureInfo(1046), // PTB - new CultureInfo(1049), // RUS - new CultureInfo(1055), // TRK - new CultureInfo(2052), // CHS - new CultureInfo(3082), // ESN - }; - public override string[] Prefixes { get { return this.prefixes; } @@ -45,10 +27,6 @@ public override string EvaluateFunction(string prefix, string function, string[] { case "guid": return this.Guid(args); - case "localeToId": - return this.LocaleToId(args); - case "localeToCulture": - return this.LocaleToCulture(args); } } @@ -63,34 +41,5 @@ private string Guid(string[] args) return new Guid(output).ToString(); } - - private string LocaleToId(string[] args) - { - return this.GetSupportedLanguage(args).LCID.ToString(); - } - - private string LocaleToCulture(string[] args) - { - return this.GetSupportedLanguage(args).Name; - } - - private CultureInfo GetSupportedLanguage(string[] args) - { - if (args.Length != 1) - { - throw new ArgumentException("Exactly one argument (locale) should be provided."); - } - - var language = this.supportedLanguages.FirstOrDefault(l => l.ThreeLetterWindowsLanguageName.ToString() == args[0]); - - if (language == null) - { - throw new ArgumentException($"Locale '{args[0]}' is not supported."); - } - else - { - return language; - } - } } } diff --git a/setup/Swix/FSharp.SDK/FSharp.SDK.swixproj b/setup/Swix/FSharp.SDK/FSharp.SDK.swixproj deleted file mode 100644 index 4b66278ec8a..00000000000 --- a/setup/Swix/FSharp.SDK/FSharp.SDK.swixproj +++ /dev/null @@ -1,23 +0,0 @@ - - - - ..\..\..\src - neutral - false - manifest - true - Debug - $(FSharpSourcesRoot)\..\$(Configuration) - $(BinariesFolder)\insertion - - - - - - $(PackagePreprocessorDefinitions);BinariesFolder=$(BinariesFolder) - - - - - - diff --git a/setup/Swix/FSharp.SDK/Files.swr b/setup/Swix/FSharp.SDK/Files.swr deleted file mode 100644 index 9b9e952323b..00000000000 --- a/setup/Swix/FSharp.SDK/Files.swr +++ /dev/null @@ -1,15 +0,0 @@ -use vs - -package name=Microsoft.FSharp.Msi - version=4.1 - vs.package.type=msi - vs.package.chip=neutral - vs.package.language=neutral - -vs.localizedResources - vs.localizedResource language=en-us - title="Visual F# Tools" - description="Deploy Visual F# Tools templates to Visual Studio" - -vs.payloads - vs.payload source=$(BinariesFolder)\msi\FSharp.SDK.ENU.msi diff --git a/setup/Swix/Microsoft.FSharp.Dependencies/Files.swr b/setup/Swix/Microsoft.FSharp.Dependencies/Files.swr new file mode 100644 index 00000000000..d7bf4f4775e --- /dev/null +++ b/setup/Swix/Microsoft.FSharp.Dependencies/Files.swr @@ -0,0 +1,31 @@ +use vs + +package name=Microsoft.FSharp.Dependencies.$(VSSku) + version=4.1 + vs.package.language=neutral + +vs.dependencies + vs.dependency id=Microsoft.FSharp.VSIX.$(VSSku) + version=4.1 + type=Required + + vs.dependency id=Microsoft.FSharp.SDK + version=4.1 + type=Required + +folder "InstallDir:MSBuild\Microsoft\VisualStudio\v15.0\FSharp" + file "Microsoft.FSharp.targets" source="$(BinariesFolder)\setup\resources\Microsoft.FSharp.Shim.targets" + file "Microsoft.Portable.FSharp.targets" source="$(BinariesFolder)\setup\resources\Microsoft.Portable.FSharp.Shim.targets" + +folder "InstallDir:Common7\IDE\PublicAssemblies" + file source="$(BinariesFolder)\net40\bin\FSharp.Core.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\FSharp.Core.optdata" + file source="$(BinariesFolder)\net40\bin\FSharp.Core.sigdata" + +folder "InstallDir:Common7\IDE\CommonExtensions\Microsoft\FSharp" + file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Conversion.Core.dll" + file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.dll" + file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Engine.dll" + file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll" + file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Tasks.Core.dll" + file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Utilities.Core.dll" \ No newline at end of file diff --git a/setup/Swix/VisualFSharpVSIX/VisualFSharpVSIX.WebDevelopment.swixproj b/setup/Swix/Microsoft.FSharp.Dependencies/Microsoft.FSharp.Dependencies.swixproj similarity index 60% rename from setup/Swix/VisualFSharpVSIX/VisualFSharpVSIX.WebDevelopment.swixproj rename to setup/Swix/Microsoft.FSharp.Dependencies/Microsoft.FSharp.Dependencies.swixproj index 30414a951c3..071b86deb08 100644 --- a/setup/Swix/VisualFSharpVSIX/VisualFSharpVSIX.WebDevelopment.swixproj +++ b/setup/Swix/Microsoft.FSharp.Dependencies/Microsoft.FSharp.Dependencies.swixproj @@ -8,8 +8,9 @@ true Debug $(FSharpSourcesRoot)\..\$(Configuration) + $(FSharpSourcesRoot)\..\packages $(BinariesFolder)\insertion - VisualFSharpVSIX.WebDevelopment + Microsoft.FSharp.Dependencies.$(VSSku) $(MSBuildThisFileDirectory)obj @@ -17,19 +18,19 @@ $(PackagePreprocessorDefinitions);BinariesFolder=$(BinariesFolder) + $(PackagePreprocessorDefinitions);PackagesFolder=$(PackagesFolder) + $(PackagePreprocessorDefinitions);VSSku=$(VSSku) - - + - - - - VsixSHA2 - - + + + + + diff --git a/setup/Swix/Microsoft.FSharp.SDK/Files.swr b/setup/Swix/Microsoft.FSharp.SDK/Files.swr new file mode 100644 index 00000000000..d161ff0fb99 --- /dev/null +++ b/setup/Swix/Microsoft.FSharp.SDK/Files.swr @@ -0,0 +1,9 @@ +use vs + +package name=Microsoft.FSharp.SDK + version=4.1 + vs.package.type=msi + vs.package.language=$(LocaleRegion) + +vs.payloads + vs.payload source="$(BinariesFolder)\msi\Microsoft.FSharp.SDK.$(LocaleCode).msi" diff --git a/setup/Swix/Microsoft.FSharp.SDK/Microsoft.FSharp.SDK.swixproj b/setup/Swix/Microsoft.FSharp.SDK/Microsoft.FSharp.SDK.swixproj new file mode 100644 index 00000000000..3e836ccb657 --- /dev/null +++ b/setup/Swix/Microsoft.FSharp.SDK/Microsoft.FSharp.SDK.swixproj @@ -0,0 +1,39 @@ + + + + ..\..\..\src + neutral + false + manifest + Microsoft.FSharp.SDK.$(LocaleCode) + true + Debug + $(FSharpSourcesRoot)\..\$(Configuration) + $(BinariesFolder)\insertion + + + + + + $(PackagePreprocessorDefinitions);BinariesFolder=$(BinariesFolder) + $(PackagePreprocessorDefinitions);LocaleCode=$(LocaleCode) + $(PackagePreprocessorDefinitions);LocaleId=$(LocaleId) + $(PackagePreprocessorDefinitions);LocaleRegion=$(LocaleRegion) + $(PackagePreprocessorDefinitions);IsLangPack=$(IsLangPack) + + + + + + + + + + + + + + + + + diff --git a/setup/Swix/Microsoft.FSharp.Vsix/Core.Files.swr b/setup/Swix/Microsoft.FSharp.Vsix/Core.Files.swr new file mode 100644 index 00000000000..952aab4ebc4 --- /dev/null +++ b/setup/Swix/Microsoft.FSharp.Vsix/Core.Files.swr @@ -0,0 +1,9 @@ +use vs + +package name=Microsoft.FSharp.VSIX.$(VSSku) + version=4.1 + vs.package.type=vsix + vs.package.language=$(LocaleRegion) + +vs.payloads + vs.payload source="$(BinariesFolder)\net40\bin\VisualFSharp$(VSSku).vsix" \ No newline at end of file diff --git a/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Desktop.Templates.swr b/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Desktop.Templates.swr new file mode 100644 index 00000000000..a3977cc67f0 --- /dev/null +++ b/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Desktop.Templates.swr @@ -0,0 +1,24 @@ +use vs + +package name=Microsoft.FSharp.VSIX.$(VSSku) + version=4.1 + vs.package.language=$(LocaleRegion) + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\ConsoleProject" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\App.config" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\ConsoleProject\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\ConsoleApplication.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\ConsoleApplication.vstemplate" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\ConsoleProject\Program.fs" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\LibraryProject" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\LibraryProject\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.vstemplate" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library1.fs" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\LibraryProject\Script.fsx" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\TutorialProject" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.fsproj" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\TutorialProject\Tutorial.fsx" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.vstemplate" diff --git a/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Files.swr b/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Files.swr new file mode 100644 index 00000000000..fa907fa0edf --- /dev/null +++ b/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Files.swr @@ -0,0 +1,21 @@ +use vs + +package name=Microsoft.FSharp.VSIX.$(VSSku) + version=4.1 + vs.package.language=$(LocaleRegion) + +folder "InstallDir:Common7\IDE\PublicAssemblies\$(LocaleRegion)" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FSharp.Core.resources.dll" vs.file.ngen=yes + +folder "InstallDir:Common7\IDE\CommonExtensions\Microsoft\FSharp\$(LocaleRegion)" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FSharp.Compiler.resources.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FSharp.Core.resources.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FSharp.LanguageService.Base.resources.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FSharp.LanguageService.Compiler.resources.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FSharp.LanguageService.resources.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FSharp.ProjectSystem.Base.resources.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FSharp.ProjectSystem.FSharp.resources.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FSharp.ProjectSystem.PropertyPages.resources.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FSharp.VS.FSI.resources.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\fsi.resources.dll" vs.file.ngen=yes + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\FsiAnyCPU.resources.dll" vs.file.ngen=yes diff --git a/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Full.Templates.swr b/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Full.Templates.swr new file mode 100644 index 00000000000..745b0f32f5e --- /dev/null +++ b/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Full.Templates.swr @@ -0,0 +1,59 @@ +use vs + +package name=Microsoft.FSharp.VSIX.$(VSSku) + version=4.1 + vs.package.language=$(LocaleRegion) + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\ConsoleProject" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\App.config" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\ConsoleProject\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\ConsoleApplication.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\ConsoleApplication.vstemplate" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\ConsoleProject\Program.fs" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\LibraryProject" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\LibraryProject\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.vstemplate" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library1.fs" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\LibraryProject\Script.fsx" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\NetCore259Project" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\NetCore259Project\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore259Project\NETCore259PortableLibrary.vstemplate" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore259Project\PortableLibrary.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore259Project\PortableLibrary1.fs" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\NetCore259Project\Script.fsx" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\NetCore78Project" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\NetCore78Project\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore78Project\NETCore78PortableLibrary.vstemplate" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore78Project\PortableLibrary.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore78Project\PortableLibrary1.fs" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\NetCore78Project\Script.fsx" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\NetCoreProject" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\NetCoreProject\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCoreProject\NETCore7PortableLibrary.vstemplate" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCoreProject\PortableLibrary.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCoreProject\PortableLibrary1.fs" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\NetCoreProject\Script.fsx" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\PortableLibraryProject" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\PortableLibraryProject\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\PortableLibraryProject\PortableLibrary.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\PortableLibraryProject\PortableLibrary.vstemplate" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\PortableLibraryProject\PortableLibrary1.fs" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\PortableLibraryProject\Script.fsx" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\SilverlightProject" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\SilverlightProject\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\Library1.fs" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\SilverlightProject\Script.fsx" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\SilverlightLibrary.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\SilverlightLibrary.vstemplate" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\TutorialProject" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.fsproj" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\TutorialProject\Tutorial.fsx" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.vstemplate" diff --git a/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Web.Templates.swr b/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Web.Templates.swr new file mode 100644 index 00000000000..e87f881c0e7 --- /dev/null +++ b/setup/Swix/Microsoft.FSharp.Vsix/LangPack.Web.Templates.swr @@ -0,0 +1,24 @@ +use vs + +package name=Microsoft.FSharp.VSIX.$(VSSku) + version=4.1 + vs.package.language=$(LocaleRegion) + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\LibraryProject" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\LibraryProject\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.vstemplate" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library1.fs" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\LibraryProject\Script.fsx" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\SilverlightProject" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\SilverlightProject\AssemblyInfo.fs" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\Library1.fs" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\SilverlightProject\Script.fsx" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\SilverlightLibrary.fsproj" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\SilverlightLibrary.vstemplate" + +folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\$(LocaleId)\TutorialProject" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.fsproj" + file source="$(BinariesFolder)\net40\bin\localize\$(LocaleCode)\ProjectTemplates\TutorialProject\Tutorial.fsx" + file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.vstemplate" diff --git a/setup/Swix/Microsoft.FSharp.Vsix/Microsoft.FSharp.Vsix.swixproj b/setup/Swix/Microsoft.FSharp.Vsix/Microsoft.FSharp.Vsix.swixproj new file mode 100644 index 00000000000..9cc2d0f1199 --- /dev/null +++ b/setup/Swix/Microsoft.FSharp.Vsix/Microsoft.FSharp.Vsix.swixproj @@ -0,0 +1,54 @@ + + + + ..\..\..\src + neutral + false + true + Debug + $(FSharpSourcesRoot)\..\$(Configuration) + $(BinariesFolder)\insertion + Microsoft.FSharp.VSIX.$(VSSku).$(LocaleCode) + $(MSBuildThisFileDirectory)obj + + + + manifest + + + + vsix + + + + + + $(PackagePreprocessorDefinitions);BinariesFolder=$(BinariesFolder) + $(PackagePreprocessorDefinitions);VSSku=$(VSSku) + $(PackagePreprocessorDefinitions);LocaleCode=$(LocaleCode) + $(PackagePreprocessorDefinitions);LocaleId=$(LocaleId) + $(PackagePreprocessorDefinitions);LocaleRegion=$(LocaleRegion) + $(PackagePreprocessorDefinitions);IsLangPack=$(IsLangPack) + + + + + + + + + + + + + + + + + + + + + + + diff --git a/setup/Swix/Microsoft.FSharp.vsmanproj b/setup/Swix/Microsoft.FSharp.vsmanproj index 300150a6576..736ea5bdb51 100644 --- a/setup/Swix/Microsoft.FSharp.vsmanproj +++ b/setup/Swix/Microsoft.FSharp.vsmanproj @@ -1,19 +1,24 @@ - - ..\..\src - true - true - true - $(FSharpSourcesRoot)\..\$(Configuration)\insertion - - - - + + + + ..\..\src + true + true + true + $(FSharpSourcesRoot)\..\$(Configuration)\insertion + + + - - - - + + + + + + + + \ No newline at end of file diff --git a/setup/Swix/VisualFSharpVSIX/CommonFiles.swr b/setup/Swix/VisualFSharpVSIX/CommonFiles.swr deleted file mode 100644 index 6bba4346f6f..00000000000 --- a/setup/Swix/VisualFSharpVSIX/CommonFiles.swr +++ /dev/null @@ -1,51 +0,0 @@ -use vs - -package name=Microsoft.FSharp.Vsix - version=4.1 - vs.package.chip=neutral - vs.package.language=en-us - -vs.localizedResources - vs.localizedResource language=en-us - title="Visual F# Tools" - description="Deploy Visual F# Tools templates to Visual Studio" - -folder "InstallDir:MSBuild\Microsoft\VisualStudio\v15.0\FSharp" - file "Microsoft.FSharp.targets" source="$(BinariesFolder)\setup\resources\Microsoft.FSharp.Shim.targets" - file "Microsoft.Portable.FSharp.targets" source="$(BinariesFolder)\setup\resources\Microsoft.Portable.FSharp.Shim.targets" - -folder "InstallDir:Common7\IDE\PublicAssemblies" - file source="$(BinariesFolder)\net40\bin\FSharp.Core.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.Core.optdata" - file source="$(BinariesFolder)\net40\bin\FSharp.Core.sigdata" - -folder "InstallDir:Common7\IDE\CommonExtensions\Microsoft\FSharp" - file source="$(BinariesFolder)\net40\bin\FSharp.Compiler.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.Compiler.Interactive.Settings.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.Compiler.Server.Shared.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.Core.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.Editor.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.LanguageService.Base.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.LanguageService.Compiler.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.LanguageService.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.ProjectSystem.Base.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.ProjectSystem.FSharp.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.ProjectSystem.PropertyPages.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.VS.FSI.dll" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\fsi.exe" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FsiAnyCPU.exe" vs.file.ngen=yes - file source="$(BinariesFolder)\net40\bin\FSharp.Core.optdata" - file source="$(BinariesFolder)\net40\bin\FSharp.Core.sigdata" - file source="$(BinariesFolder)\net40\bin\fsi.exe.config" - file source="$(BinariesFolder)\net40\bin\fsiAnyCpu.exe.config" - file source="$(BinariesFolder)\..\License.txt" - file source="$(BinariesFolder)\net40\bin\RegisterFsharpPackage.pkgdef" - file source="$(BinariesFolder)\net40\bin\FSharp.Compiler.Server.Shared.pkgdef" - file source="$(BinariesFolder)\net40\bin\FSharp.Editor.pkgdef" - file source="$(BinariesFolder)\net40\bin\FSharp.LanguageService.Base.pkgdef" - file source="$(BinariesFolder)\net40\bin\FSharp.LanguageService.Compiler.pkgdef" - file source="$(BinariesFolder)\net40\bin\FSharp.LanguageService.pkgdef" - file source="$(BinariesFolder)\net40\bin\FSharp.ProjectSystem.Base.pkgdef" - file source="$(BinariesFolder)\net40\bin\FSharp.ProjectSystem.FSharp.pkgdef" - file source="$(BinariesFolder)\net40\bin\FSharp.ProjectSystem.PropertyPages.pkgdef" - file source="$(BinariesFolder)\net40\bin\FSharp.VS.FSI.pkgdef" diff --git a/setup/Swix/VisualFSharpVSIX/DesktopTemplates.swr b/setup/Swix/VisualFSharpVSIX/DesktopTemplates.swr deleted file mode 100644 index 3e3beb3fdfc..00000000000 --- a/setup/Swix/VisualFSharpVSIX/DesktopTemplates.swr +++ /dev/null @@ -1,54 +0,0 @@ -use vs - -package name=Microsoft.FSharp.Vsix - version=4.1 - vs.package.chip=neutral - vs.package.language=en-us - -vs.localizedResources - vs.localizedResource language=en-us - title="Visual F# Tools" - description="Deploy Visual F# Tools templates to Visual Studio" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\AppConfig" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\AppConfig\App.config" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\AppConfig\AppConfig.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\CodeFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\CodeFile\CodeFile.vstemplate" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\CodeFile\File.fs" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\ScriptFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\ScriptFile\File.fsx" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\ScriptFile\ScriptFile.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\SignatureFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\SignatureFile\File.fsi" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\SignatureFile\SignatureFile.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\TextFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\TextFile\TextFile.txt" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\TextFile\TextFile.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\XMLFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\XMLFile\XMLFile.vstemplate" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\XMLFile\XMLFile.xml" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\ConsoleProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\App.config" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\ConsoleApplication.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\ConsoleApplication.vstemplate" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\Program.fs" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\LibraryProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.vstemplate" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library1.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Script.fsx" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\TutorialProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.fsx" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.vstemplate" diff --git a/setup/Swix/VisualFSharpVSIX/ProfessionalTemplates.swr b/setup/Swix/VisualFSharpVSIX/ProfessionalTemplates.swr deleted file mode 100644 index e0e8a0e1e34..00000000000 --- a/setup/Swix/VisualFSharpVSIX/ProfessionalTemplates.swr +++ /dev/null @@ -1,89 +0,0 @@ -use vs - -package name=Microsoft.FSharp.Vsix - version=4.1 - vs.package.chip=neutral - vs.package.language=en-us - -vs.localizedResources - vs.localizedResource language=en-us - title="Visual F# Tools" - description="Deploy Visual F# Tools templates to Visual Studio" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\AppConfig" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\AppConfig\App.config" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\AppConfig\AppConfig.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\CodeFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\CodeFile\CodeFile.vstemplate" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\CodeFile\File.fs" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\ScriptFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\ScriptFile\File.fsx" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\ScriptFile\ScriptFile.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\SignatureFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\SignatureFile\File.fsi" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\SignatureFile\SignatureFile.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\TextFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\TextFile\TextFile.txt" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\TextFile\TextFile.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\XMLFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\XMLFile\XMLFile.vstemplate" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\XMLFile\XMLFile.xml" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\ConsoleProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\App.config" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\ConsoleApplication.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\ConsoleApplication.vstemplate" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\ConsoleProject\Program.fs" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\LibraryProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.vstemplate" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library1.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Script.fsx" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\NetCore259Project" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore259Project\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore259Project\NETCore259PortableLibrary.vstemplate" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore259Project\PortableLibrary.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore259Project\PortableLibrary1.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore259Project\Script.fsx" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\NetCore78Project" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore78Project\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore78Project\NETCore78PortableLibrary.vstemplate" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore78Project\PortableLibrary.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore78Project\PortableLibrary1.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCore78Project\Script.fsx" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\NetCoreProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCoreProject\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCoreProject\NETCore7PortableLibrary.vstemplate" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCoreProject\PortableLibrary.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCoreProject\PortableLibrary1.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\NetCoreProject\Script.fsx" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\PortableLibraryProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\PortableLibraryProject\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\PortableLibraryProject\PortableLibrary.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\PortableLibraryProject\PortableLibrary.vstemplate" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\PortableLibraryProject\PortableLibrary1.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\PortableLibraryProject\Script.fsx" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\SilverlightProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\Library1.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\Script.fsx" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\SilverlightLibrary.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\SilverlightLibrary.vstemplate" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\TutorialProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.fsx" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.vstemplate" diff --git a/setup/Swix/VisualFSharpVSIX/VisualFSharpVSIX.Desktop.swixproj b/setup/Swix/VisualFSharpVSIX/VisualFSharpVSIX.Desktop.swixproj deleted file mode 100644 index cc70a56b5e6..00000000000 --- a/setup/Swix/VisualFSharpVSIX/VisualFSharpVSIX.Desktop.swixproj +++ /dev/null @@ -1,35 +0,0 @@ - - - - ..\..\..\src - neutral - false - vsix - true - Debug - $(FSharpSourcesRoot)\..\$(Configuration) - $(BinariesFolder)\insertion - VisualFSharpVSIX.Desktop - $(MSBuildThisFileDirectory)obj - - - - - - $(PackagePreprocessorDefinitions);BinariesFolder=$(BinariesFolder) - - - - - - - - - - - - VsixSHA2 - - - - diff --git a/setup/Swix/VisualFSharpVSIX/VisualFSharpVSIX.Professional.swixproj b/setup/Swix/VisualFSharpVSIX/VisualFSharpVSIX.Professional.swixproj deleted file mode 100644 index 12cd1f9139e..00000000000 --- a/setup/Swix/VisualFSharpVSIX/VisualFSharpVSIX.Professional.swixproj +++ /dev/null @@ -1,35 +0,0 @@ - - - - ..\..\..\src - neutral - false - vsix - true - Debug - $(FSharpSourcesRoot)\..\$(Configuration) - $(BinariesFolder)\insertion - VisualFSharpVSIX.Professional - $(MSBuildThisFileDirectory)obj - - - - - - $(PackagePreprocessorDefinitions);BinariesFolder=$(BinariesFolder) - - - - - - - - - - - - VsixSHA2 - - - - diff --git a/setup/Swix/VisualFSharpVSIX/WebDevelopmentTemplates.swr b/setup/Swix/VisualFSharpVSIX/WebDevelopmentTemplates.swr deleted file mode 100644 index ef2bc075cc4..00000000000 --- a/setup/Swix/VisualFSharpVSIX/WebDevelopmentTemplates.swr +++ /dev/null @@ -1,54 +0,0 @@ -use vs - -package name=Microsoft.FSharp.Vsix - version=4.1 - vs.package.chip=neutral - vs.package.language=en-us - -vs.localizedResources - vs.localizedResource language=en-us - title="Visual F# Tools" - description="Deploy Visual F# Tools templates to Visual Studio" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\AppConfig" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\AppConfig\App.config" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\AppConfig\AppConfig.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\CodeFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\CodeFile\CodeFile.vstemplate" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\CodeFile\File.fs" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\ScriptFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\ScriptFile\File.fsx" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\ScriptFile\ScriptFile.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\SignatureFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\SignatureFile\File.fsi" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\SignatureFile\SignatureFile.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\TextFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\TextFile\TextFile.txt" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\TextFile\TextFile.vstemplate" - -folder "InstallDir:Common7\IDE\ItemTemplates\FSharp\XMLFile" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\XMLFile\XMLFile.vstemplate" - file source="$(BinariesFolder)\net40\bin\ItemTemplates\XMLFile\XMLFile.xml" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\LibraryProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library.vstemplate" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Library1.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\LibraryProject\Script.fsx" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\SilverlightProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\AssemblyInfo.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\Library1.fs" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\Script.fsx" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\SilverlightLibrary.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\SilverlightProject\SilverlightLibrary.vstemplate" - -folder "InstallDir:Common7\IDE\ProjectTemplates\FSharp\TutorialProject" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.fsproj" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.fsx" - file source="$(BinariesFolder)\net40\bin\ProjectTemplates\TutorialProject\Tutorial.vstemplate" diff --git a/setup/fsharp-setup-build.proj b/setup/fsharp-setup-build.proj index be9ad8f2a22..87ca1c6d400 100644 --- a/setup/fsharp-setup-build.proj +++ b/setup/fsharp-setup-build.proj @@ -6,61 +6,69 @@ . net40 - ENU Debug - - - - - - - - - - - - - - + + + + + FSharp.Wix.Extensions\FSharp.Wix.Extensions.csproj + + + + + + + + + + + + + + + + + + + + + + Swix\Microsoft.FSharp.Dependencies\Microsoft.FSharp.Dependencies.swixproj + Full + + + + Swix\Microsoft.FSharp.vsmanproj + + + - - + - - - - - - - - + - - - - - - - - - - + + - - - - - - - - - - + + diff --git a/src/FSharpSource.Settings.targets b/src/FSharpSource.Settings.targets index 0ce697c555c..c1969b9e378 100644 --- a/src/FSharpSource.Settings.targets +++ b/src/FSharpSource.Settings.targets @@ -85,6 +85,9 @@ fsi.exe fslex.exe fsyacc.exe + 2.0.0-beta1 + 14.0 + 14.3.25407 diff --git a/src/FSharpSource.targets b/src/FSharpSource.targets index c7e41a74668..617313d2fbb 100644 --- a/src/FSharpSource.targets +++ b/src/FSharpSource.targets @@ -119,7 +119,6 @@ - $(DefineConstants);OPEN_BUILD false @@ -132,9 +131,6 @@ 2.0.3 2.0.3.0 $(FSharpSourcesRoot)\..\packages\FsCheck.$(FsCheckVersion)\lib\ - 1.0.30 - 1.1.37 - 2.0.0-beta1 @@ -162,7 +158,6 @@ - v4.5 $(DefineConstants);FSHARP_CORE_4_5 $(DefineConstants);FX_ATLEAST_45 $(DefineConstants);FX_ATLEAST_40 @@ -746,7 +741,7 @@ ..\lkg\FSharp-$(LkgVersion)\bin\Microsoft.FSharp.Targets - $(FSharpSourcesRoot)\..\lkg\bin\Debug\dnxcore50\win7-x64\publish + $(FSharpSourcesRoot)\..\lkg\bin\Debug\netstandard1.6\win7-x64\publish $(FSharpSourcesRoot)\..\lkg\FSharp-$(LkgVersion)\bin $(FSLKGPath)\FSharp.Core.dll diff --git a/src/absil/il.fs b/src/absil/il.fs index 8287cfb3aa1..5a0cdee0b60 100755 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -2063,6 +2063,8 @@ let mkILFormalGenericArgs (gparams:ILGenericParameterDefs) = let mkILFormalBoxedTy tref gparams = mkILBoxedTy tref (mkILFormalGenericArgs gparams) +let mkILFormalNamedTy bx tref gparams = mkILNamedTy bx tref (mkILFormalGenericArgs gparams) + // -------------------------------------------------------------------- // Operations on class etc. defs. // -------------------------------------------------------------------- diff --git a/src/absil/il.fsi b/src/absil/il.fsi index 4a81afa084f..d61e3c24f5a 100644 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -1676,6 +1676,7 @@ val mkILTySpecRaw: ILTypeRef * ILGenericArgs -> ILTypeSpec /// Make types. val mkILTy: ILBoxity -> ILTypeSpec -> ILType val mkILNamedTy: ILBoxity -> ILTypeRef -> ILGenericArgsList -> ILType +val mkILNamedTyRaw: ILBoxity -> ILTypeRef -> ILGenericArgs -> ILType val mkILBoxedTy: ILTypeRef -> ILGenericArgsList -> ILType val mkILBoxedTyRaw: ILTypeRef -> ILGenericArgs -> ILType val mkILValueTy: ILTypeRef -> ILGenericArgsList -> ILType @@ -1727,6 +1728,7 @@ val mkILCallSig: ILCallingConv * ILType list * ILType -> ILCallingSignature /// Make generalized verions of possibly-generic types, /// e.g. Given the ILTypeDef for List, return the type "List". val mkILFormalBoxedTy: ILTypeRef -> ILGenericParameterDef list -> ILType +val mkILFormalNamedTy: ILBoxity -> ILTypeRef -> ILGenericParameterDef list -> ILType val mkILFormalTyparsRaw: ILTypes -> ILGenericParameterDefs val mkILFormalTypars: ILType list -> ILGenericParameterDefs @@ -2090,9 +2092,7 @@ type ILPropertyRef = member Name: string interface System.IComparable -#if ENABLE_MONO_SUPPORT val runningOnMono: bool -#endif type ILReferences = { AssemblyReferences: ILAssemblyRef list; diff --git a/src/absil/ildiag.fs b/src/absil/ildiag.fs index 44d0713c55d..ae5fd915468 100644 --- a/src/absil/ildiag.fs +++ b/src/absil/ildiag.fs @@ -7,6 +7,9 @@ module internal Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Internal.Utilities let diagnosticsLog = ref (Some stdout) + +let setDiagnosticsChannel s = diagnosticsLog := s + let dflushn () = match !diagnosticsLog with None -> () | Some d -> d.WriteLine(); d.Flush() let dflush () = match !diagnosticsLog with None -> () | Some d -> d.Flush() let dprintn (s:string) = @@ -18,4 +21,3 @@ let dprintf (fmt: Format<_,_,_,_>) = let dprintfn (fmt: Format<_,_,_,_>) = Printf.kfprintf dflushn (match !diagnosticsLog with None -> System.IO.TextWriter.Null | Some d -> d) fmt -let setDiagnosticsChannel s = diagnosticsLog := s diff --git a/src/absil/ildiag.fsi b/src/absil/ildiag.fsi index 682cab7bdb1..b7aeb603414 100644 --- a/src/absil/ildiag.fsi +++ b/src/absil/ildiag.fsi @@ -11,9 +11,8 @@ module internal Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open System.IO open Microsoft.FSharp.Core.Printf -val public setDiagnosticsChannel: TextWriter option -> unit +val public setDiagnosticsChannel: TextWriter option -> unit val public dprintfn: TextWriterFormat<'a> -> 'a val public dprintf: TextWriterFormat<'a> -> 'a - val public dprintn: string -> unit diff --git a/src/absil/ilprint.fs b/src/absil/ilprint.fs index 819cfdb74ee..b8289f30b0f 100644 --- a/src/absil/ilprint.fs +++ b/src/absil/ilprint.fs @@ -439,12 +439,12 @@ let goutput_alternative_ref env os (alt: IlxUnionAlternative) = output_id os alt.Name; alt.FieldDefs |> Array.toList |> output_parens (output_seq "," (fun os fdef -> goutput_typ env os fdef.Type)) os -let goutput_curef env os (IlxUnionRef(tref,alts,_,_)) = +let goutput_curef env os (IlxUnionRef(_,tref,alts,_,_)) = output_string os " .classunion import "; goutput_tref env os tref; output_parens (output_seq "," (goutput_alternative_ref env)) os (Array.toList alts) -let goutput_cuspec env os (IlxUnionSpec(IlxUnionRef(tref,_,_,_),i)) = +let goutput_cuspec env os (IlxUnionSpec(IlxUnionRef(_,tref,_,_,_),i)) = output_string os "class /* classunion */ "; goutput_tref env os tref; goutput_gactuals env os i diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index b5cebc17372..353b3b114d2 100644 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -29,8 +29,8 @@ open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.NativeInterop type ILReaderOptions = - { pdbPath: string option; - ilGlobals: ILGlobals; + { pdbPath: string option + ilGlobals: ILGlobals optimizeForMemory: bool } #if STATISTICS @@ -160,22 +160,22 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) = inherit BinaryFile() static member Create fileName = - //printf "fileName = %s\n" fileName; + //printf "fileName = %s\n" fileName let hFile = MemoryMapping.CreateFile (fileName, MemoryMapping.GENERIC_READ, MemoryMapping.FILE_SHARE_READ_WRITE, IntPtr.Zero, MemoryMapping.OPEN_EXISTING, 0, IntPtr.Zero ) - //printf "hFile = %Lx\n" (hFile.ToInt64()); + //printf "hFile = %Lx\n" (hFile.ToInt64()) if ( hFile.Equals(MemoryMapping.INVALID_HANDLE) ) then - failwithf "CreateFile(0x%08x)" ( Marshal.GetHRForLastWin32Error() ); + failwithf "CreateFile(0x%08x)" ( Marshal.GetHRForLastWin32Error() ) let protection = 0x00000002 (* ReadOnly *) - //printf "OK! hFile = %Lx\n" (hFile.ToInt64()); + //printf "OK! hFile = %Lx\n" (hFile.ToInt64()) let hMap = MemoryMapping.CreateFileMapping (hFile, IntPtr.Zero, protection, 0,0, null ) - ignore(MemoryMapping.CloseHandle(hFile)); + ignore(MemoryMapping.CloseHandle(hFile)) if hMap.Equals(MemoryMapping.NULL_HANDLE) then - failwithf "CreateFileMapping(0x%08x)" ( Marshal.GetHRForLastWin32Error() ); + failwithf "CreateFileMapping(0x%08x)" ( Marshal.GetHRForLastWin32Error() ) let start = MemoryMapping.MapViewOfFile (hMap, MemoryMapping.MAP_READ,0,0,0n) if start.Equals(IntPtr.Zero) then - failwithf "MapViewOfFile(0x%08x)" ( Marshal.GetHRForLastWin32Error() ); + failwithf "MapViewOfFile(0x%08x)" ( Marshal.GetHRForLastWin32Error() ) MemoryMappedFile(hMap, start) member m.Addr (i:int) : nativeint = @@ -186,7 +186,7 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) = override m.ReadBytes i len = let res = Bytes.zeroCreate len - Marshal.Copy(m.Addr i, res, 0,len); + Marshal.Copy(m.Addr i, res, 0,len) res override m.ReadInt32 i = @@ -196,7 +196,7 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) = NativePtr.read (NativePtr.ofNativeInt (m.Addr i)) member m.Close() = - ignore(MemoryMapping.UnmapViewOfFile start); + ignore(MemoryMapping.UnmapViewOfFile start) ignore(MemoryMapping.CloseHandle hMap) override m.CountUtf8String i = @@ -325,7 +325,7 @@ let sigptrCheck (bytes:byte[]) sigptr = // member x.GetByte() = let res = bytes.[curr] in curr <- curr + 1; res let sigptrGetByte (bytes:byte[]) sigptr = - sigptrCheck bytes sigptr; + sigptrCheck bytes sigptr bytes.[sigptr], sigptr + 1 let sigptrGetBool bytes sigptr = @@ -346,7 +346,7 @@ let sigptrGetInt16 bytes sigptr = int16 u,sigptr let sigptrGetInt32 bytes sigptr = - sigptrCheck bytes sigptr; + sigptrCheck bytes sigptr let b0 = bytes.[sigptr] let b1 = bytes.[sigptr+1] let b2 = bytes.[sigptr+2] @@ -402,7 +402,7 @@ let sigptrFold f n (bytes:byte[]) (sigptr:int) = let sigptrGetBytes n (bytes:byte[]) sigptr = if checking && sigptr + n >= bytes.Length then - dprintn "read past end of sig. in sigptrGetString"; + dprintn "read past end of sig. in sigptrGetString" Bytes.zeroCreate 0, sigptr else let res = Bytes.zeroCreate n @@ -421,51 +421,51 @@ let sigptrGetString n bytes sigptr = [] type ILInstrPrefixesRegister = - { mutable al: ILAlignment; - mutable tl: ILTailcall; - mutable vol: ILVolatility; - mutable ro: ILReadonly; + { mutable al: ILAlignment + mutable tl: ILTailcall + mutable vol: ILVolatility + mutable ro: ILReadonly mutable constrained: ILType option} let noPrefixes mk prefixes = - if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here"; - if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here"; - if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here"; - if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here"; - if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here"; + if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" + if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here" + if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here" + if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here" + if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here" mk let volatileOrUnalignedPrefix mk prefixes = - if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here"; - if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here"; - if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here"; + if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here" + if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here" + if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here" mk (prefixes.al,prefixes.vol) let volatilePrefix mk prefixes = - if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here"; - if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here"; - if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here"; - if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here"; + if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" + if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here" + if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here" + if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here" mk prefixes.vol let tailPrefix mk prefixes = - if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here"; - if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here"; - if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here"; - if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here"; + if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" + if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here" + if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here" + if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here" mk prefixes.tl let constraintOrTailPrefix mk prefixes = - if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here"; - if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here"; - if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here"; + if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" + if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here" + if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here" mk (prefixes.constrained,prefixes.tl ) let readonlyPrefix mk prefixes = - if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here"; - if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here"; - if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here"; - if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here"; + if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" + if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here" + if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here" + if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here" mk prefixes.ro @@ -496,103 +496,103 @@ let mkStind dt = volatileOrUnalignedPrefix (fun (x,y) -> I_stind(x,y,dt)) let mkLdind dt = volatileOrUnalignedPrefix (fun (x,y) -> I_ldind(x,y,dt)) let instrs () = - [ i_ldarg_s, I_u16_u8_instr (noPrefixes mkLdarg); - i_starg_s, I_u16_u8_instr (noPrefixes I_starg); - i_ldarga_s, I_u16_u8_instr (noPrefixes I_ldarga); - i_stloc_s, I_u16_u8_instr (noPrefixes mkStloc); - i_ldloc_s, I_u16_u8_instr (noPrefixes mkLdloc); - i_ldloca_s, I_u16_u8_instr (noPrefixes I_ldloca); - i_ldarg, I_u16_u16_instr (noPrefixes mkLdarg); - i_starg, I_u16_u16_instr (noPrefixes I_starg); - i_ldarga, I_u16_u16_instr (noPrefixes I_ldarga); - i_stloc, I_u16_u16_instr (noPrefixes mkStloc); - i_ldloc, I_u16_u16_instr (noPrefixes mkLdloc); - i_ldloca, I_u16_u16_instr (noPrefixes I_ldloca); - i_stind_i, I_none_instr (mkStind DT_I); - i_stind_i1, I_none_instr (mkStind DT_I1); - i_stind_i2, I_none_instr (mkStind DT_I2); - i_stind_i4, I_none_instr (mkStind DT_I4); - i_stind_i8, I_none_instr (mkStind DT_I8); - i_stind_r4, I_none_instr (mkStind DT_R4); - i_stind_r8, I_none_instr (mkStind DT_R8); - i_stind_ref, I_none_instr (mkStind DT_REF); - i_ldind_i, I_none_instr (mkLdind DT_I); - i_ldind_i1, I_none_instr (mkLdind DT_I1); - i_ldind_i2, I_none_instr (mkLdind DT_I2); - i_ldind_i4, I_none_instr (mkLdind DT_I4); - i_ldind_i8, I_none_instr (mkLdind DT_I8); - i_ldind_u1, I_none_instr (mkLdind DT_U1); - i_ldind_u2, I_none_instr (mkLdind DT_U2); - i_ldind_u4, I_none_instr (mkLdind DT_U4); - i_ldind_r4, I_none_instr (mkLdind DT_R4); - i_ldind_r8, I_none_instr (mkLdind DT_R8); - i_ldind_ref, I_none_instr (mkLdind DT_REF); - i_cpblk, I_none_instr (volatileOrUnalignedPrefix I_cpblk); - i_initblk, I_none_instr (volatileOrUnalignedPrefix I_initblk); - i_ldc_i8, I_i64_instr (noPrefixes (fun x ->(AI_ldc (DT_I8, ILConst.I8 x)))); - i_ldc_i4, I_i32_i32_instr (noPrefixes mkLdcInt32); - i_ldc_i4_s, I_i32_i8_instr (noPrefixes mkLdcInt32); - i_ldc_r4, I_r4_instr (noPrefixes (fun x -> (AI_ldc (DT_R4, ILConst.R4 x)))); - i_ldc_r8, I_r8_instr (noPrefixes (fun x -> (AI_ldc (DT_R8, ILConst.R8 x)))); - i_ldfld, I_field_instr (volatileOrUnalignedPrefix(fun (x,y) fspec -> I_ldfld(x,y,fspec))); - i_stfld, I_field_instr (volatileOrUnalignedPrefix(fun (x,y) fspec -> I_stfld(x,y,fspec))); - i_ldsfld, I_field_instr (volatilePrefix (fun x fspec -> I_ldsfld (x, fspec))); - i_stsfld, I_field_instr (volatilePrefix (fun x fspec -> I_stsfld (x, fspec))); - i_ldflda, I_field_instr (noPrefixes I_ldflda); - i_ldsflda, I_field_instr (noPrefixes I_ldsflda); - i_call, I_method_instr (tailPrefix (fun tl (mspec,y) -> I_call (tl,mspec,y))); - i_ldftn, I_method_instr (noPrefixes (fun (mspec,_y) -> I_ldftn mspec)); - i_ldvirtftn, I_method_instr (noPrefixes (fun (mspec,_y) -> I_ldvirtftn mspec)); - i_newobj, I_method_instr (noPrefixes I_newobj); - i_callvirt, I_method_instr (constraintOrTailPrefix (fun (c,tl) (mspec,y) -> match c with Some ty -> I_callconstraint(tl,ty,mspec,y) | None -> I_callvirt (tl,mspec,y))); - i_leave_s, I_unconditional_i8_instr (noPrefixes (fun x -> I_leave x)); - i_br_s, I_unconditional_i8_instr (noPrefixes I_br); - i_leave, I_unconditional_i32_instr (noPrefixes (fun x -> I_leave x)); - i_br, I_unconditional_i32_instr (noPrefixes I_br); - i_brtrue_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue,x))); - i_brfalse_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse,x))); - i_beq_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_beq,x))); - i_blt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt,x))); - i_blt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un,x))); - i_ble_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble,x))); - i_ble_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un,x))); - i_bgt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt,x))); - i_bgt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un,x))); - i_bge_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge,x))); - i_bge_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un,x))); - i_bne_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un,x))); - i_brtrue, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue,x))); - i_brfalse, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse,x))); - i_beq, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_beq,x))); - i_blt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt,x))); - i_blt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un,x))); - i_ble, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble,x))); - i_ble_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un,x))); - i_bgt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt,x))); - i_bgt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un,x))); - i_bge, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge,x))); - i_bge_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un,x))); - i_bne_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un,x))); - i_ldstr, I_string_instr (noPrefixes I_ldstr); - i_switch, I_switch_instr (noPrefixes I_switch); - i_ldtoken, I_tok_instr (noPrefixes I_ldtoken); - i_calli, I_sig_instr (tailPrefix (fun tl (x,y) -> I_calli (tl, x, y))); - i_mkrefany, I_type_instr (noPrefixes I_mkrefany); - i_refanyval, I_type_instr (noPrefixes I_refanyval); - i_ldelema, I_type_instr (readonlyPrefix (fun ro x -> I_ldelema (ro,false,ILArrayShape.SingleDimensional,x))); - i_ldelem_any, I_type_instr (noPrefixes (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional,x))); - i_stelem_any, I_type_instr (noPrefixes (fun x -> I_stelem_any (ILArrayShape.SingleDimensional,x))); - i_newarr, I_type_instr (noPrefixes (fun x -> I_newarr (ILArrayShape.SingleDimensional,x))); - i_castclass, I_type_instr (noPrefixes I_castclass); - i_isinst, I_type_instr (noPrefixes I_isinst); - i_unbox_any, I_type_instr (noPrefixes I_unbox_any); - i_cpobj, I_type_instr (noPrefixes I_cpobj); - i_initobj, I_type_instr (noPrefixes I_initobj); - i_ldobj, I_type_instr (volatileOrUnalignedPrefix (fun (x,y) z -> I_ldobj (x,y,z))); - i_stobj, I_type_instr (volatileOrUnalignedPrefix (fun (x,y) z -> I_stobj (x,y,z))); - i_sizeof, I_type_instr (noPrefixes I_sizeof); - i_box, I_type_instr (noPrefixes I_box); - i_unbox, I_type_instr (noPrefixes I_unbox); ] + [ i_ldarg_s, I_u16_u8_instr (noPrefixes mkLdarg) + i_starg_s, I_u16_u8_instr (noPrefixes I_starg) + i_ldarga_s, I_u16_u8_instr (noPrefixes I_ldarga) + i_stloc_s, I_u16_u8_instr (noPrefixes mkStloc) + i_ldloc_s, I_u16_u8_instr (noPrefixes mkLdloc) + i_ldloca_s, I_u16_u8_instr (noPrefixes I_ldloca) + i_ldarg, I_u16_u16_instr (noPrefixes mkLdarg) + i_starg, I_u16_u16_instr (noPrefixes I_starg) + i_ldarga, I_u16_u16_instr (noPrefixes I_ldarga) + i_stloc, I_u16_u16_instr (noPrefixes mkStloc) + i_ldloc, I_u16_u16_instr (noPrefixes mkLdloc) + i_ldloca, I_u16_u16_instr (noPrefixes I_ldloca) + i_stind_i, I_none_instr (mkStind DT_I) + i_stind_i1, I_none_instr (mkStind DT_I1) + i_stind_i2, I_none_instr (mkStind DT_I2) + i_stind_i4, I_none_instr (mkStind DT_I4) + i_stind_i8, I_none_instr (mkStind DT_I8) + i_stind_r4, I_none_instr (mkStind DT_R4) + i_stind_r8, I_none_instr (mkStind DT_R8) + i_stind_ref, I_none_instr (mkStind DT_REF) + i_ldind_i, I_none_instr (mkLdind DT_I) + i_ldind_i1, I_none_instr (mkLdind DT_I1) + i_ldind_i2, I_none_instr (mkLdind DT_I2) + i_ldind_i4, I_none_instr (mkLdind DT_I4) + i_ldind_i8, I_none_instr (mkLdind DT_I8) + i_ldind_u1, I_none_instr (mkLdind DT_U1) + i_ldind_u2, I_none_instr (mkLdind DT_U2) + i_ldind_u4, I_none_instr (mkLdind DT_U4) + i_ldind_r4, I_none_instr (mkLdind DT_R4) + i_ldind_r8, I_none_instr (mkLdind DT_R8) + i_ldind_ref, I_none_instr (mkLdind DT_REF) + i_cpblk, I_none_instr (volatileOrUnalignedPrefix I_cpblk) + i_initblk, I_none_instr (volatileOrUnalignedPrefix I_initblk) + i_ldc_i8, I_i64_instr (noPrefixes (fun x ->(AI_ldc (DT_I8, ILConst.I8 x)))) + i_ldc_i4, I_i32_i32_instr (noPrefixes mkLdcInt32) + i_ldc_i4_s, I_i32_i8_instr (noPrefixes mkLdcInt32) + i_ldc_r4, I_r4_instr (noPrefixes (fun x -> (AI_ldc (DT_R4, ILConst.R4 x)))) + i_ldc_r8, I_r8_instr (noPrefixes (fun x -> (AI_ldc (DT_R8, ILConst.R8 x)))) + i_ldfld, I_field_instr (volatileOrUnalignedPrefix(fun (x,y) fspec -> I_ldfld(x,y,fspec))) + i_stfld, I_field_instr (volatileOrUnalignedPrefix(fun (x,y) fspec -> I_stfld(x,y,fspec))) + i_ldsfld, I_field_instr (volatilePrefix (fun x fspec -> I_ldsfld (x, fspec))) + i_stsfld, I_field_instr (volatilePrefix (fun x fspec -> I_stsfld (x, fspec))) + i_ldflda, I_field_instr (noPrefixes I_ldflda) + i_ldsflda, I_field_instr (noPrefixes I_ldsflda) + i_call, I_method_instr (tailPrefix (fun tl (mspec,y) -> I_call (tl,mspec,y))) + i_ldftn, I_method_instr (noPrefixes (fun (mspec,_y) -> I_ldftn mspec)) + i_ldvirtftn, I_method_instr (noPrefixes (fun (mspec,_y) -> I_ldvirtftn mspec)) + i_newobj, I_method_instr (noPrefixes I_newobj) + i_callvirt, I_method_instr (constraintOrTailPrefix (fun (c,tl) (mspec,y) -> match c with Some ty -> I_callconstraint(tl,ty,mspec,y) | None -> I_callvirt (tl,mspec,y))) + i_leave_s, I_unconditional_i8_instr (noPrefixes (fun x -> I_leave x)) + i_br_s, I_unconditional_i8_instr (noPrefixes I_br) + i_leave, I_unconditional_i32_instr (noPrefixes (fun x -> I_leave x)) + i_br, I_unconditional_i32_instr (noPrefixes I_br) + i_brtrue_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue,x))) + i_brfalse_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse,x))) + i_beq_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_beq,x))) + i_blt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt,x))) + i_blt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un,x))) + i_ble_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble,x))) + i_ble_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un,x))) + i_bgt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt,x))) + i_bgt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un,x))) + i_bge_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge,x))) + i_bge_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un,x))) + i_bne_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un,x))) + i_brtrue, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue,x))) + i_brfalse, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse,x))) + i_beq, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_beq,x))) + i_blt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt,x))) + i_blt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un,x))) + i_ble, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble,x))) + i_ble_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un,x))) + i_bgt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt,x))) + i_bgt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un,x))) + i_bge, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge,x))) + i_bge_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un,x))) + i_bne_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un,x))) + i_ldstr, I_string_instr (noPrefixes I_ldstr) + i_switch, I_switch_instr (noPrefixes I_switch) + i_ldtoken, I_tok_instr (noPrefixes I_ldtoken) + i_calli, I_sig_instr (tailPrefix (fun tl (x,y) -> I_calli (tl, x, y))) + i_mkrefany, I_type_instr (noPrefixes I_mkrefany) + i_refanyval, I_type_instr (noPrefixes I_refanyval) + i_ldelema, I_type_instr (readonlyPrefix (fun ro x -> I_ldelema (ro,false,ILArrayShape.SingleDimensional,x))) + i_ldelem_any, I_type_instr (noPrefixes (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional,x))) + i_stelem_any, I_type_instr (noPrefixes (fun x -> I_stelem_any (ILArrayShape.SingleDimensional,x))) + i_newarr, I_type_instr (noPrefixes (fun x -> I_newarr (ILArrayShape.SingleDimensional,x))) + i_castclass, I_type_instr (noPrefixes I_castclass) + i_isinst, I_type_instr (noPrefixes I_isinst) + i_unbox_any, I_type_instr (noPrefixes I_unbox_any) + i_cpobj, I_type_instr (noPrefixes I_cpobj) + i_initobj, I_type_instr (noPrefixes I_initobj) + i_ldobj, I_type_instr (volatileOrUnalignedPrefix (fun (x,y) z -> I_ldobj (x,y,z))) + i_stobj, I_type_instr (volatileOrUnalignedPrefix (fun (x,y) z -> I_stobj (x,y,z))) + i_sizeof, I_type_instr (noPrefixes I_sizeof) + i_box, I_type_instr (noPrefixes I_box) + i_unbox, I_type_instr (noPrefixes I_unbox) ] // The tables are delayed to avoid building them unnecessarily at startup // Many applications of AbsIL (e.g. a compiler) don't need to read instructions. @@ -603,20 +603,20 @@ let fillInstrs () = let twoByteInstrTable = Array.create 256 I_invalid_instr let addInstr (i,f) = if i > 0xff then - assert (i >>>& 8 = 0xfe); + assert (i >>>& 8 = 0xfe) let i = (i &&& 0xff) match twoByteInstrTable.[i] with | I_invalid_instr -> () - | _ -> dprintn ("warning: duplicate decode entries for "+string i); + | _ -> dprintn ("warning: duplicate decode entries for "+string i) twoByteInstrTable.[i] <- f else match oneByteInstrTable.[i] with | I_invalid_instr -> () - | _ -> dprintn ("warning: duplicate decode entries for "+string i); + | _ -> dprintn ("warning: duplicate decode entries for "+string i) oneByteInstrTable.[i] <- f - List.iter addInstr (instrs()); - List.iter (fun (x,mk) -> addInstr (x,I_none_instr (noPrefixes mk))) (noArgInstrs.Force()); - oneByteInstrs := Some oneByteInstrTable; + List.iter addInstr (instrs()) + List.iter (fun (x,mk) -> addInstr (x,I_none_instr (noPrefixes mk))) (noArgInstrs.Force()) + oneByteInstrs := Some oneByteInstrTable twoByteInstrs := Some twoByteInstrTable let rec getOneByteInstr i = @@ -758,7 +758,7 @@ let mkCacheInt32 lowMem _inbase _nm _sz = let cache = ref null let count = ref 0 #if STATISTICS - addReport (fun oc -> if !count <> 0 then oc.WriteLine ((_inbase + string !count + " "+ _nm + " cache hits") : string)); + addReport (fun oc -> if !count <> 0 then oc.WriteLine ((_inbase + string !count + " "+ _nm + " cache hits") : string)) #endif fun f (idx:int32) -> let cache = @@ -769,11 +769,11 @@ let mkCacheInt32 lowMem _inbase _nm _sz = let mutable res = Unchecked.defaultof<_> let ok = cache.TryGetValue(idx, &res) if ok then - incr count; + incr count res else let res = f idx - cache.[idx] <- res; + cache.[idx] <- res res let mkCacheGeneric lowMem _inbase _nm _sz = @@ -781,7 +781,7 @@ let mkCacheGeneric lowMem _inbase _nm _sz = let cache = ref null let count = ref 0 #if STATISTICS - addReport (fun oc -> if !count <> 0 then oc.WriteLine ((_inbase + string !count + " " + _nm + " cache hits") : string)); + addReport (fun oc -> if !count <> 0 then oc.WriteLine ((_inbase + string !count + " " + _nm + " cache hits") : string)) #endif fun f (idx :'T) -> let cache = @@ -799,8 +799,8 @@ let mkCacheGeneric lowMem _inbase _nm _sz = let seekFindRow numRows rowChooser = let mutable i = 1 while (i <= numRows && not (rowChooser i)) do - i <- i + 1; - if i > numRows then dprintn "warning: seekFindRow: row not found"; + i <- i + 1 + if i > numRows then dprintn "warning: seekFindRow: row not found" i // search for rows satisfying predicate @@ -823,7 +823,7 @@ let seekReadIndexedRows (numRows, rowReader, keyFunc, keyComparer, binaryChop, r high <- mid else fin <- true - end; + end let mutable res = [] if high - low > 1 then // now read off rows, forward and backwards @@ -834,17 +834,17 @@ let seekReadIndexedRows (numRows, rowReader, keyFunc, keyComparer, binaryChop, r let mutable curr = mid while not fin do if curr > numRows then - fin <- true; + fin <- true else let currrow = rowReader curr if keyComparer (keyFunc currrow) = 0 then - res <- rowConverter currrow :: res; + res <- rowConverter currrow :: res else - fin <- true; - curr <- curr + 1; - done; - end; - res <- List.rev res; + fin <- true + curr <- curr + 1 + done + end + res <- List.rev res // read backwards begin let mutable fin = false @@ -855,11 +855,11 @@ let seekReadIndexedRows (numRows, rowReader, keyFunc, keyComparer, binaryChop, r else let currrow = rowReader curr if keyComparer (keyFunc currrow) = 0 then - res <- rowConverter currrow :: res; + res <- rowConverter currrow :: res else - fin <- true; - curr <- curr - 1; - end; + fin <- true + curr <- curr - 1 + end // sanity check #if CHECKING if checking then @@ -878,7 +878,7 @@ let seekReadIndexedRows (numRows, rowReader, keyFunc, keyComparer, binaryChop, r for i = 1 to numRows do let rowinfo = rowReader i if keyComparer (keyFunc rowinfo) = 0 then - res := rowConverter rowinfo :: !res; + res := rowConverter rowinfo :: !res List.rev !res @@ -887,7 +887,7 @@ let seekReadOptionalIndexedRow (info) = | [k] -> Some k | [] -> None | h::_ -> - dprintn ("multiple rows found when indexing table"); + dprintn ("multiple rows found when indexing table") Some h let seekReadIndexedRow (info) = @@ -900,7 +900,7 @@ let seekReadIndexedRow (info) = //--------------------------------------------------------------------- type ILModuleReader = - { modul: ILModuleDef; + { modul: ILModuleDef ilAssemblyRefs: Lazy dispose: unit -> unit } member x.ILModuleDef = x.modul @@ -914,113 +914,113 @@ type VarArgMethodData = VarArgMethodData of ILType * ILCallingConv * string * IL [] type ILReaderContext = - { ilg: ILGlobals; - dataEndPoints: Lazy; - sorted: int64; + { ilg: ILGlobals + dataEndPoints: Lazy + sorted: int64 #if FX_NO_PDB_READER - pdb: obj option; + pdb: obj option #else - pdb: (PdbReader * (string -> ILSourceDocument)) option; + pdb: (PdbReader * (string -> ILSourceDocument)) option #endif - entryPointToken: TableName * int; - getNumRows: TableName -> int; - textSegmentPhysicalLoc : int32; - textSegmentPhysicalSize : int32; - dataSegmentPhysicalLoc : int32; - dataSegmentPhysicalSize : int32; - anyV2P : (string * int32) -> int32; - metadataAddr: int32; - sectionHeaders : (int32 * int32 * int32) list; - nativeResourcesAddr:int32; - nativeResourcesSize:int32; - resourcesAddr:int32; - strongnameAddr:int32; - vtableFixupsAddr:int32; - is: BinaryFile; - infile:string; - userStringsStreamPhysicalLoc: int32; - stringsStreamPhysicalLoc: int32; - blobsStreamPhysicalLoc: int32; - blobsStreamSize: int32; - readUserStringHeap: (int32 -> string); - memoizeString: string -> string; - readStringHeap: (int32 -> string); - readBlobHeap: (int32 -> byte[]); - guidsStreamPhysicalLoc : int32; - rowAddr : (TableName -> int -> int32); - tableBigness : bool array; - rsBigness : bool; - tdorBigness : bool; - tomdBigness : bool; - hcBigness : bool; - hcaBigness : bool; - hfmBigness : bool; - hdsBigness : bool; - mrpBigness : bool; - hsBigness : bool; - mdorBigness : bool; - mfBigness : bool; - iBigness : bool; - catBigness : bool; - stringsBigness: bool; - guidsBigness: bool; - blobsBigness: bool; - countTypeRef : int ref; - countTypeDef : int ref; - countField : int ref; - countMethod : int ref; - countParam : int ref; - countInterfaceImpl : int ref; - countMemberRef : int ref; - countConstant : int ref; - countCustomAttribute : int ref; - countFieldMarshal: int ref; - countPermission : int ref; - countClassLayout : int ref; - countFieldLayout : int ref; - countStandAloneSig : int ref; - countEventMap : int ref; - countEvent : int ref; - countPropertyMap : int ref; - countProperty : int ref; - countMethodSemantics : int ref; - countMethodImpl : int ref; - countModuleRef : int ref; - countTypeSpec : int ref; - countImplMap : int ref; - countFieldRVA : int ref; - countAssembly : int ref; - countAssemblyRef : int ref; - countFile : int ref; - countExportedType : int ref; - countManifestResource : int ref; - countNested : int ref; - countGenericParam : int ref; - countGenericParamConstraint : int ref; - countMethodSpec : int ref; - seekReadNestedRow : int -> int * int; - seekReadConstantRow : int -> uint16 * TaggedIndex * int32; - seekReadMethodSemanticsRow : int -> int32 * int * TaggedIndex; - seekReadTypeDefRow : int -> int32 * int32 * int32 * TaggedIndex * int * int; - seekReadInterfaceImplRow : int -> int * TaggedIndex; - seekReadFieldMarshalRow : int -> TaggedIndex * int32; - seekReadPropertyMapRow : int -> int * int; - seekReadAssemblyRef : int -> ILAssemblyRef; - seekReadMethodSpecAsMethodData : MethodSpecAsMspecIdx -> VarArgMethodData; - seekReadMemberRefAsMethodData : MemberRefAsMspecIdx -> VarArgMethodData; - seekReadMemberRefAsFieldSpec : MemberRefAsFspecIdx -> ILFieldSpec; - seekReadCustomAttr : CustomAttrIdx -> ILAttribute; - seekReadSecurityDecl : SecurityDeclIdx -> ILPermission; - seekReadTypeRef : int ->ILTypeRef; - seekReadTypeRefAsType : TypeRefAsTypIdx -> ILType; - readBlobHeapAsPropertySig : BlobAsPropSigIdx -> ILThisConvention * ILType * ILTypes; - readBlobHeapAsFieldSig : BlobAsFieldSigIdx -> ILType; - readBlobHeapAsMethodSig : BlobAsMethodSigIdx -> bool * int32 * ILCallingConv * ILType * ILTypes * ILVarArgs; - readBlobHeapAsLocalsSig : BlobAsLocalSigIdx -> ILLocal list; - seekReadTypeDefAsType : TypeDefAsTypIdx -> ILType; - seekReadMethodDefAsMethodData : int -> MethodData; - seekReadGenericParams : GenericParamsIdx -> ILGenericParameterDef list; - seekReadFieldDefAsFieldSpec : int -> ILFieldSpec; } + entryPointToken: TableName * int + getNumRows: TableName -> int + textSegmentPhysicalLoc : int32 + textSegmentPhysicalSize : int32 + dataSegmentPhysicalLoc : int32 + dataSegmentPhysicalSize : int32 + anyV2P : (string * int32) -> int32 + metadataAddr: int32 + sectionHeaders : (int32 * int32 * int32) list + nativeResourcesAddr:int32 + nativeResourcesSize:int32 + resourcesAddr:int32 + strongnameAddr:int32 + vtableFixupsAddr:int32 + is: BinaryFile + infile:string + userStringsStreamPhysicalLoc: int32 + stringsStreamPhysicalLoc: int32 + blobsStreamPhysicalLoc: int32 + blobsStreamSize: int32 + readUserStringHeap: (int32 -> string) + memoizeString: string -> string + readStringHeap: (int32 -> string) + readBlobHeap: (int32 -> byte[]) + guidsStreamPhysicalLoc : int32 + rowAddr : (TableName -> int -> int32) + tableBigness : bool array + rsBigness : bool + tdorBigness : bool + tomdBigness : bool + hcBigness : bool + hcaBigness : bool + hfmBigness : bool + hdsBigness : bool + mrpBigness : bool + hsBigness : bool + mdorBigness : bool + mfBigness : bool + iBigness : bool + catBigness : bool + stringsBigness: bool + guidsBigness: bool + blobsBigness: bool + countTypeRef : int ref + countTypeDef : int ref + countField : int ref + countMethod : int ref + countParam : int ref + countInterfaceImpl : int ref + countMemberRef : int ref + countConstant : int ref + countCustomAttribute : int ref + countFieldMarshal: int ref + countPermission : int ref + countClassLayout : int ref + countFieldLayout : int ref + countStandAloneSig : int ref + countEventMap : int ref + countEvent : int ref + countPropertyMap : int ref + countProperty : int ref + countMethodSemantics : int ref + countMethodImpl : int ref + countModuleRef : int ref + countTypeSpec : int ref + countImplMap : int ref + countFieldRVA : int ref + countAssembly : int ref + countAssemblyRef : int ref + countFile : int ref + countExportedType : int ref + countManifestResource : int ref + countNested : int ref + countGenericParam : int ref + countGenericParamConstraint : int ref + countMethodSpec : int ref + seekReadNestedRow : int -> int * int + seekReadConstantRow : int -> uint16 * TaggedIndex * int32 + seekReadMethodSemanticsRow : int -> int32 * int * TaggedIndex + seekReadTypeDefRow : int -> int32 * int32 * int32 * TaggedIndex * int * int + seekReadInterfaceImplRow : int -> int * TaggedIndex + seekReadFieldMarshalRow : int -> TaggedIndex * int32 + seekReadPropertyMapRow : int -> int * int + seekReadAssemblyRef : int -> ILAssemblyRef + seekReadMethodSpecAsMethodData : MethodSpecAsMspecIdx -> VarArgMethodData + seekReadMemberRefAsMethodData : MemberRefAsMspecIdx -> VarArgMethodData + seekReadMemberRefAsFieldSpec : MemberRefAsFspecIdx -> ILFieldSpec + seekReadCustomAttr : CustomAttrIdx -> ILAttribute + seekReadSecurityDecl : SecurityDeclIdx -> ILPermission + seekReadTypeRef : int ->ILTypeRef + seekReadTypeRefAsType : TypeRefAsTypIdx -> ILType + readBlobHeapAsPropertySig : BlobAsPropSigIdx -> ILThisConvention * ILType * ILTypes + readBlobHeapAsFieldSig : BlobAsFieldSigIdx -> ILType + readBlobHeapAsMethodSig : BlobAsMethodSigIdx -> bool * int32 * ILCallingConv * ILType * ILTypes * ILVarArgs + readBlobHeapAsLocalsSig : BlobAsLocalSigIdx -> ILLocal list + seekReadTypeDefAsType : TypeDefAsTypIdx -> ILType + seekReadMethodDefAsMethodData : int -> MethodData + seekReadGenericParams : GenericParamsIdx -> ILGenericParameterDef list + seekReadFieldDefAsFieldSpec : int -> ILFieldSpec } let count c = #if DEBUG @@ -1076,7 +1076,7 @@ let seekReadGuidIdx ctxt (addr: byref) = seekReadIdx ctxt.guidsBigness ctxt let seekReadBlobIdx ctxt (addr: byref) = seekReadIdx ctxt.blobsBigness ctxt &addr let seekReadModuleRow ctxt idx = - if idx = 0 then failwith "cannot read Module table row 0"; + if idx = 0 then failwith "cannot read Module table row 0" let mutable addr = ctxt.rowAddr TableNames.Module idx let generation = seekReadUInt16Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr @@ -1087,7 +1087,7 @@ let seekReadModuleRow ctxt idx = /// Read Table ILTypeRef. let seekReadTypeRefRow ctxt idx = - count ctxt.countTypeRef; + count ctxt.countTypeRef let mutable addr = ctxt.rowAddr TableNames.TypeRef idx let scopeIdx = seekReadResolutionScopeIdx ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr @@ -1098,7 +1098,7 @@ let seekReadTypeRefRow ctxt idx = let seekReadTypeDefRow ctxt idx = ctxt.seekReadTypeDefRow idx let seekReadTypeDefRowUncached ctxtH idx = let ctxt = getHole ctxtH - count ctxt.countTypeDef; + count ctxt.countTypeDef let mutable addr = ctxt.rowAddr TableNames.TypeDef idx let flags = seekReadInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr @@ -1110,7 +1110,7 @@ let seekReadTypeDefRowUncached ctxtH idx = /// Read Table Field. let seekReadFieldRow ctxt idx = - count ctxt.countField; + count ctxt.countField let mutable addr = ctxt.rowAddr TableNames.Field idx let flags = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr @@ -1119,7 +1119,7 @@ let seekReadFieldRow ctxt idx = /// Read Table Method. let seekReadMethodRow ctxt idx = - count ctxt.countMethod; + count ctxt.countMethod let mutable addr = ctxt.rowAddr TableNames.Method idx let codeRVA = seekReadInt32Adv ctxt &addr let implflags = seekReadUInt16AsInt32Adv ctxt &addr @@ -1131,7 +1131,7 @@ let seekReadMethodRow ctxt idx = /// Read Table Param. let seekReadParamRow ctxt idx = - count ctxt.countParam; + count ctxt.countParam let mutable addr = ctxt.rowAddr TableNames.Param idx let flags = seekReadUInt16AsInt32Adv ctxt &addr let seq = seekReadUInt16AsInt32Adv ctxt &addr @@ -1142,7 +1142,7 @@ let seekReadParamRow ctxt idx = let seekReadInterfaceImplRow ctxt idx = ctxt.seekReadInterfaceImplRow idx let seekReadInterfaceImplRowUncached ctxtH idx = let ctxt = getHole ctxtH - count ctxt.countInterfaceImpl; + count ctxt.countInterfaceImpl let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let intfIdx = seekReadTypeDefOrRefOrSpecIdx ctxt &addr @@ -1150,7 +1150,7 @@ let seekReadInterfaceImplRowUncached ctxtH idx = /// Read Table MemberRef. let seekReadMemberRefRow ctxt idx = - count ctxt.countMemberRef; + count ctxt.countMemberRef let mutable addr = ctxt.rowAddr TableNames.MemberRef idx let mrpIdx = seekReadMemberRefParentIdx ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr @@ -1161,7 +1161,7 @@ let seekReadMemberRefRow ctxt idx = let seekReadConstantRow ctxt idx = ctxt.seekReadConstantRow idx let seekReadConstantRowUncached ctxtH idx = let ctxt = getHole ctxtH - count ctxt.countConstant; + count ctxt.countConstant let mutable addr = ctxt.rowAddr TableNames.Constant idx let kind = seekReadUInt16Adv ctxt &addr let parentIdx = seekReadHasConstantIdx ctxt &addr @@ -1170,7 +1170,7 @@ let seekReadConstantRowUncached ctxtH idx = /// Read Table CustomAttribute. let seekReadCustomAttributeRow ctxt idx = - count ctxt.countCustomAttribute; + count ctxt.countCustomAttribute let mutable addr = ctxt.rowAddr TableNames.CustomAttribute idx let parentIdx = seekReadHasCustomAttributeIdx ctxt &addr let typeIdx = seekReadCustomAttributeTypeIdx ctxt &addr @@ -1181,7 +1181,7 @@ let seekReadCustomAttributeRow ctxt idx = let seekReadFieldMarshalRow ctxt idx = ctxt.seekReadFieldMarshalRow idx let seekReadFieldMarshalRowUncached ctxtH idx = let ctxt = getHole ctxtH - count ctxt.countFieldMarshal; + count ctxt.countFieldMarshal let mutable addr = ctxt.rowAddr TableNames.FieldMarshal idx let parentIdx = seekReadHasFieldMarshalIdx ctxt &addr let typeIdx = seekReadBlobIdx ctxt &addr @@ -1189,7 +1189,7 @@ let seekReadFieldMarshalRowUncached ctxtH idx = /// Read Table Permission. let seekReadPermissionRow ctxt idx = - count ctxt.countPermission; + count ctxt.countPermission let mutable addr = ctxt.rowAddr TableNames.Permission idx let action = seekReadUInt16Adv ctxt &addr let parentIdx = seekReadHasDeclSecurityIdx ctxt &addr @@ -1198,7 +1198,7 @@ let seekReadPermissionRow ctxt idx = /// Read Table ClassLayout. let seekReadClassLayoutRow ctxt idx = - count ctxt.countClassLayout; + count ctxt.countClassLayout let mutable addr = ctxt.rowAddr TableNames.ClassLayout idx let pack = seekReadUInt16Adv ctxt &addr let size = seekReadInt32Adv ctxt &addr @@ -1207,7 +1207,7 @@ let seekReadClassLayoutRow ctxt idx = /// Read Table FieldLayout. let seekReadFieldLayoutRow ctxt idx = - count ctxt.countFieldLayout; + count ctxt.countFieldLayout let mutable addr = ctxt.rowAddr TableNames.FieldLayout idx let offset = seekReadInt32Adv ctxt &addr let fidx = seekReadUntaggedIdx TableNames.Field ctxt &addr @@ -1215,14 +1215,14 @@ let seekReadFieldLayoutRow ctxt idx = //// Read Table StandAloneSig. let seekReadStandAloneSigRow ctxt idx = - count ctxt.countStandAloneSig; + count ctxt.countStandAloneSig let mutable addr = ctxt.rowAddr TableNames.StandAloneSig idx let sigIdx = seekReadBlobIdx ctxt &addr sigIdx /// Read Table EventMap. let seekReadEventMapRow ctxt idx = - count ctxt.countEventMap; + count ctxt.countEventMap let mutable addr = ctxt.rowAddr TableNames.EventMap idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let eventsIdx = seekReadUntaggedIdx TableNames.Event ctxt &addr @@ -1230,7 +1230,7 @@ let seekReadEventMapRow ctxt idx = /// Read Table Event. let seekReadEventRow ctxt idx = - count ctxt.countEvent; + count ctxt.countEvent let mutable addr = ctxt.rowAddr TableNames.Event idx let flags = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr @@ -1241,7 +1241,7 @@ let seekReadEventRow ctxt idx = let seekReadPropertyMapRow ctxt idx = ctxt.seekReadPropertyMapRow idx let seekReadPropertyMapRowUncached ctxtH idx = let ctxt = getHole ctxtH - count ctxt.countPropertyMap; + count ctxt.countPropertyMap let mutable addr = ctxt.rowAddr TableNames.PropertyMap idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let propsIdx = seekReadUntaggedIdx TableNames.Property ctxt &addr @@ -1249,7 +1249,7 @@ let seekReadPropertyMapRowUncached ctxtH idx = /// Read Table Property. let seekReadPropertyRow ctxt idx = - count ctxt.countProperty; + count ctxt.countProperty let mutable addr = ctxt.rowAddr TableNames.Property idx let flags = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr @@ -1260,7 +1260,7 @@ let seekReadPropertyRow ctxt idx = let seekReadMethodSemanticsRow ctxt idx = ctxt.seekReadMethodSemanticsRow idx let seekReadMethodSemanticsRowUncached ctxtH idx = let ctxt = getHole ctxtH - count ctxt.countMethodSemantics; + count ctxt.countMethodSemantics let mutable addr = ctxt.rowAddr TableNames.MethodSemantics idx let flags = seekReadUInt16AsInt32Adv ctxt &addr let midx = seekReadUntaggedIdx TableNames.Method ctxt &addr @@ -1269,7 +1269,7 @@ let seekReadMethodSemanticsRowUncached ctxtH idx = /// Read Table MethodImpl. let seekReadMethodImplRow ctxt idx = - count ctxt.countMethodImpl; + count ctxt.countMethodImpl let mutable addr = ctxt.rowAddr TableNames.MethodImpl idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let mbodyIdx = seekReadMethodDefOrRefIdx ctxt &addr @@ -1278,21 +1278,21 @@ let seekReadMethodImplRow ctxt idx = /// Read Table ILModuleRef. let seekReadModuleRefRow ctxt idx = - count ctxt.countModuleRef; + count ctxt.countModuleRef let mutable addr = ctxt.rowAddr TableNames.ModuleRef idx let nameIdx = seekReadStringIdx ctxt &addr nameIdx /// Read Table ILTypeSpec. let seekReadTypeSpecRow ctxt idx = - count ctxt.countTypeSpec; + count ctxt.countTypeSpec let mutable addr = ctxt.rowAddr TableNames.TypeSpec idx let blobIdx = seekReadBlobIdx ctxt &addr blobIdx /// Read Table ImplMap. let seekReadImplMapRow ctxt idx = - count ctxt.countImplMap; + count ctxt.countImplMap let mutable addr = ctxt.rowAddr TableNames.ImplMap idx let flags = seekReadUInt16AsInt32Adv ctxt &addr let forwrdedIdx = seekReadMemberForwardedIdx ctxt &addr @@ -1302,7 +1302,7 @@ let seekReadImplMapRow ctxt idx = /// Read Table FieldRVA. let seekReadFieldRVARow ctxt idx = - count ctxt.countFieldRVA; + count ctxt.countFieldRVA let mutable addr = ctxt.rowAddr TableNames.FieldRVA idx let rva = seekReadInt32Adv ctxt &addr let fidx = seekReadUntaggedIdx TableNames.Field ctxt &addr @@ -1310,7 +1310,7 @@ let seekReadFieldRVARow ctxt idx = /// Read Table Assembly. let seekReadAssemblyRow ctxt idx = - count ctxt.countAssembly; + count ctxt.countAssembly let mutable addr = ctxt.rowAddr TableNames.Assembly idx let hash = seekReadInt32Adv ctxt &addr let v1 = seekReadUInt16Adv ctxt &addr @@ -1325,7 +1325,7 @@ let seekReadAssemblyRow ctxt idx = /// Read Table ILAssemblyRef. let seekReadAssemblyRefRow ctxt idx = - count ctxt.countAssemblyRef; + count ctxt.countAssemblyRef let mutable addr = ctxt.rowAddr TableNames.AssemblyRef idx let v1 = seekReadUInt16Adv ctxt &addr let v2 = seekReadUInt16Adv ctxt &addr @@ -1340,7 +1340,7 @@ let seekReadAssemblyRefRow ctxt idx = /// Read Table File. let seekReadFileRow ctxt idx = - count ctxt.countFile; + count ctxt.countFile let mutable addr = ctxt.rowAddr TableNames.File idx let flags = seekReadInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr @@ -1349,7 +1349,7 @@ let seekReadFileRow ctxt idx = /// Read Table ILExportedTypeOrForwarder. let seekReadExportedTypeRow ctxt idx = - count ctxt.countExportedType; + count ctxt.countExportedType let mutable addr = ctxt.rowAddr TableNames.ExportedType idx let flags = seekReadInt32Adv ctxt &addr let tok = seekReadInt32Adv ctxt &addr @@ -1360,7 +1360,7 @@ let seekReadExportedTypeRow ctxt idx = /// Read Table ManifestResource. let seekReadManifestResourceRow ctxt idx = - count ctxt.countManifestResource; + count ctxt.countManifestResource let mutable addr = ctxt.rowAddr TableNames.ManifestResource idx let offset = seekReadInt32Adv ctxt &addr let flags = seekReadInt32Adv ctxt &addr @@ -1372,7 +1372,7 @@ let seekReadManifestResourceRow ctxt idx = let seekReadNestedRow ctxt idx = ctxt.seekReadNestedRow idx let seekReadNestedRowUncached ctxtH idx = let ctxt = getHole ctxtH - count ctxt.countNested; + count ctxt.countNested let mutable addr = ctxt.rowAddr TableNames.Nested idx let nestedIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let enclIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr @@ -1380,7 +1380,7 @@ let seekReadNestedRowUncached ctxtH idx = /// Read Table GenericParam. let seekReadGenericParamRow ctxt idx = - count ctxt.countGenericParam; + count ctxt.countGenericParam let mutable addr = ctxt.rowAddr TableNames.GenericParam idx let seq = seekReadUInt16Adv ctxt &addr let flags = seekReadUInt16Adv ctxt &addr @@ -1390,7 +1390,7 @@ let seekReadGenericParamRow ctxt idx = // Read Table GenericParamConstraint. let seekReadGenericParamConstraintRow ctxt idx = - count ctxt.countGenericParamConstraint; + count ctxt.countGenericParamConstraint let mutable addr = ctxt.rowAddr TableNames.GenericParamConstraint idx let pidx = seekReadUntaggedIdx TableNames.GenericParam ctxt &addr let constraintIdx = seekReadTypeDefOrRefOrSpecIdx ctxt &addr @@ -1398,7 +1398,7 @@ let seekReadGenericParamConstraintRow ctxt idx = /// Read Table ILMethodSpec. let seekReadMethodSpecRow ctxt idx = - count ctxt.countMethodSpec; + count ctxt.countMethodSpec let mutable addr = ctxt.rowAddr TableNames.MethodSpec idx let mdorIdx = seekReadMethodDefOrRefIdx ctxt &addr let instIdx = seekReadBlobIdx ctxt &addr @@ -1479,12 +1479,12 @@ let dataEndPoints ctxtH = let res = ref [] for i = 1 to ctxt.getNumRows (TableNames.FieldRVA) do let rva,_fidx = seekReadFieldRVARow ctxt i - res := ("field",rva) :: !res; + res := ("field",rva) :: !res for i = 1 to ctxt.getNumRows TableNames.ManifestResource do let (offset,_,_,TaggedIndex(_tag,idx)) = seekReadManifestResourceRow ctxt i if idx = 0 then let rva = ctxt.resourcesAddr + offset - res := ("manifest resource", rva) :: !res; + res := ("manifest resource", rva) :: !res !res if isNil dataStartPoints then [] else @@ -1494,19 +1494,19 @@ let dataEndPoints ctxtH = let (rva, _, _, nameIdx, _, _) = seekReadMethodRow ctxt i if rva <> 0 then let nm = readStringHeap ctxt nameIdx - res := (nm,rva) :: !res; + res := (nm,rva) :: !res !res - ([ ctxt.textSegmentPhysicalLoc + ctxt.textSegmentPhysicalSize; - ctxt.dataSegmentPhysicalLoc + ctxt.dataSegmentPhysicalSize; ] + ([ ctxt.textSegmentPhysicalLoc + ctxt.textSegmentPhysicalSize ; + ctxt.dataSegmentPhysicalLoc + ctxt.dataSegmentPhysicalSize ] @ (List.map ctxt.anyV2P (dataStartPoints @ [for (virtAddr,_virtSize,_physLoc) in ctxt.sectionHeaders do yield ("section start",virtAddr) done] @ [("md",ctxt.metadataAddr)] - @ (if ctxt.nativeResourcesAddr = 0x0 then [] else [("native resources",ctxt.nativeResourcesAddr); ]) - @ (if ctxt.resourcesAddr = 0x0 then [] else [("managed resources",ctxt.resourcesAddr); ]) - @ (if ctxt.strongnameAddr = 0x0 then [] else [("managed strongname",ctxt.strongnameAddr); ]) - @ (if ctxt.vtableFixupsAddr = 0x0 then [] else [("managed vtable_fixups",ctxt.vtableFixupsAddr); ]) + @ (if ctxt.nativeResourcesAddr = 0x0 then [] else [("native resources",ctxt.nativeResourcesAddr) ]) + @ (if ctxt.resourcesAddr = 0x0 then [] else [("managed resources",ctxt.resourcesAddr) ]) + @ (if ctxt.strongnameAddr = 0x0 then [] else [("managed strongname",ctxt.strongnameAddr) ]) + @ (if ctxt.vtableFixupsAddr = 0x0 then [] else [("managed vtable_fixups",ctxt.vtableFixupsAddr) ]) @ methodRVAs))) // Make distinct |> Set.ofList @@ -1515,7 +1515,7 @@ let dataEndPoints ctxtH = let rec rvaToData ctxt nm rva = - if rva = 0x0 then failwith "rva is zero"; + if rva = 0x0 then failwith "rva is zero" let start = ctxt.anyV2P (nm, rva) let endPoints = (Lazy.force ctxt.dataEndPoints) let rec look l = @@ -1543,38 +1543,38 @@ let rec seekReadModule ctxt (subsys,subsysversion,useHighEntropyVA, ilOnly,only3 { Manifest = if ctxt.getNumRows (TableNames.Assembly) > 0 then Some (seekReadAssemblyManifest ctxt 1) - else None; - CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Module,idx)); - Name = ilModuleName; - NativeResources=nativeResources; - TypeDefs = mkILTypeDefsComputed (fun () -> seekReadTopTypeDefs ctxt ()); - SubSystemFlags = int32 subsys; - IsILOnly = ilOnly; + else None + CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Module,idx)) + Name = ilModuleName + NativeResources=nativeResources + TypeDefs = mkILTypeDefsComputed (fun () -> seekReadTopTypeDefs ctxt ()) + SubSystemFlags = int32 subsys + IsILOnly = ilOnly SubsystemVersion = subsysversion UseHighEntropyVA = useHighEntropyVA - Platform = platform; - StackReserveSize = None; // TODO - Is32Bit = only32; - Is32BitPreferred = is32bitpreferred; - Is64Bit = only64; - IsDLL=isDll; - VirtualAlignment = alignVirt; - PhysicalAlignment = alignPhys; - ImageBase = imageBaseReal; - MetadataVersion = ilMetadataVersion; - Resources = seekReadManifestResources ctxt (); } + Platform = platform + StackReserveSize = None // TODO + Is32Bit = only32 + Is32BitPreferred = is32bitpreferred + Is64Bit = only64 + IsDLL=isDll + VirtualAlignment = alignVirt + PhysicalAlignment = alignPhys + ImageBase = imageBaseReal + MetadataVersion = ilMetadataVersion + Resources = seekReadManifestResources ctxt () } and seekReadAssemblyManifest ctxt idx = let (hash,v1,v2,v3,v4,flags,publicKeyIdx, nameIdx, localeIdx) = seekReadAssemblyRow ctxt idx let name = readStringHeap ctxt nameIdx let pubkey = readBlobHeapOption ctxt publicKeyIdx - { Name= name; - AuxModuleHashAlgorithm=hash; - SecurityDecls= seekReadSecurityDecls ctxt (TaggedIndex(hds_Assembly,idx)); - PublicKey= pubkey; - Version= Some (v1,v2,v3,v4); - Locale= readStringHeapOption ctxt localeIdx; - CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Assembly,idx)); + { Name= name + AuxModuleHashAlgorithm=hash + SecurityDecls= seekReadSecurityDecls ctxt (TaggedIndex(hds_Assembly,idx)) + PublicKey= pubkey + Version= Some (v1,v2,v3,v4) + Locale= readStringHeapOption ctxt localeIdx + CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Assembly,idx)) AssemblyLongevity= begin let masked = flags &&& 0x000e if masked = 0x0000 then ILAssemblyLongevity.Unspecified @@ -1583,12 +1583,12 @@ and seekReadAssemblyManifest ctxt idx = elif masked = 0x0006 then ILAssemblyLongevity.PlatformProcess elif masked = 0x0008 then ILAssemblyLongevity.PlatformSystem else ILAssemblyLongevity.Unspecified - end; - ExportedTypes= seekReadTopExportedTypes ctxt (); - EntrypointElsewhere=(if fst ctxt.entryPointToken = TableNames.File then Some (seekReadFile ctxt (snd ctxt.entryPointToken)) else None); - Retargetable = 0 <> (flags &&& 0x100); - DisableJitOptimizations = 0 <> (flags &&& 0x4000); - JitTracking = 0 <> (flags &&& 0x8000); } + end + ExportedTypes= seekReadTopExportedTypes ctxt () + EntrypointElsewhere=(if fst ctxt.entryPointToken = TableNames.File then Some (seekReadFile ctxt (snd ctxt.entryPointToken)) else None) + Retargetable = 0 <> (flags &&& 0x100) + DisableJitOptimizations = 0 <> (flags &&& 0x4000) + JitTracking = 0 <> (flags &&& 0x8000) } and seekReadAssemblyRef ctxt idx = ctxt.seekReadAssemblyRef idx and seekReadAssemblyRefUncached ctxtH idx = @@ -1606,7 +1606,7 @@ and seekReadAssemblyRefUncached ctxtH idx = publicKey=publicKey, retargetable=((flags &&& 0x0100) <> 0x0), version=Some(v1,v2,v3,v4), - locale=readStringHeapOption ctxt localeIdx;) + locale=readStringHeapOption ctxt localeIdx) and seekReadModuleRef ctxt idx = let (nameIdx) = seekReadModuleRefRow ctxt idx @@ -1623,8 +1623,7 @@ and seekReadFile ctxt idx = and seekReadClassLayout ctxt idx = match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.ClassLayout,seekReadClassLayoutRow ctxt,(fun (_,_,tidx) -> tidx),simpleIndexCompare idx,isSorted ctxt TableNames.ClassLayout,(fun (pack,size,_) -> pack,size)) with | None -> { Size = None; Pack = None } - | Some (pack,size) -> { Size = Some size; - Pack = Some pack; } + | Some (pack,size) -> { Size = Some size; Pack = Some pack } and memberAccessOfFlags flags = let f = (flags &&& 0x00000007) @@ -1736,32 +1735,32 @@ and seekReadTypeDef ctxt toponly (idx:int) = let mimpls = seekReadMethodImpls ctxt numtypars idx let props = seekReadProperties ctxt numtypars idx let events = seekReadEvents ctxt numtypars idx - { tdKind= kind; - Name=nm; - GenericParams=typars; - Access= typeAccessOfFlags flags; - IsAbstract= (flags &&& 0x00000080) <> 0x0; - IsSealed= (flags &&& 0x00000100) <> 0x0; - IsSerializable= (flags &&& 0x00002000) <> 0x0; - IsComInterop= (flags &&& 0x00001000) <> 0x0; - Layout = layout; - IsSpecialName= (flags &&& 0x00000400) <> 0x0; - Encoding=typeEncodingOfFlags flags; - NestedTypes= nested; - Implements = mkILTypes impls; - Extends = super; - Methods = mdefs; - SecurityDecls = sdecls; - HasSecurity=(flags &&& 0x00040000) <> 0x0; - Fields=fdefs; - MethodImpls=mimpls; + { tdKind= kind + Name=nm + GenericParams=typars + Access= typeAccessOfFlags flags + IsAbstract= (flags &&& 0x00000080) <> 0x0 + IsSealed= (flags &&& 0x00000100) <> 0x0 + IsSerializable= (flags &&& 0x00002000) <> 0x0 + IsComInterop= (flags &&& 0x00001000) <> 0x0 + Layout = layout + IsSpecialName= (flags &&& 0x00000400) <> 0x0 + Encoding=typeEncodingOfFlags flags + NestedTypes= nested + Implements = mkILTypes impls + Extends = super + Methods = mdefs + SecurityDecls = sdecls + HasSecurity=(flags &&& 0x00040000) <> 0x0 + Fields=fdefs + MethodImpls=mimpls InitSemantics= if kind = ILTypeDefKind.Interface then ILTypeInit.OnAny elif (flags &&& 0x00100000) <> 0x0 then ILTypeInit.BeforeField - else ILTypeInit.OnAny; - Events= events; - Properties=props; - CustomAttrs=cas; } + else ILTypeInit.OnAny + Events= events + Properties=props + CustomAttrs=cas } Some (ns,n,cas,rest) and seekReadTopTypeDefs ctxt () = @@ -1807,13 +1806,13 @@ and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars,a,b)) = else NonVariant let constraints = seekReadGenericParamConstraintsUncached ctxt numtypars gpidx let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_GenericParam,gpidx)) - seq, {Name=readStringHeap ctxt nameIdx; - Constraints=mkILTypes constraints; - Variance=variance; - CustomAttrs=cas; - HasReferenceTypeConstraint= (flags &&& 0x0004) <> 0; - HasNotNullableValueTypeConstraint= (flags &&& 0x0008) <> 0; - HasDefaultConstructorConstraint=(flags &&& 0x0010) <> 0; })) + seq, {Name=readStringHeap ctxt nameIdx + Constraints=mkILTypes constraints + Variance=variance + CustomAttrs=cas + HasReferenceTypeConstraint= (flags &&& 0x0004) <> 0 + HasNotNullableValueTypeConstraint= (flags &&& 0x0008) <> 0 + HasDefaultConstructorConstraint=(flags &&& 0x0010) <> 0 })) pars |> List.sortBy fst |> List.map snd and seekReadGenericParamConstraintsUncached ctxt numtypars gpidx = @@ -1861,7 +1860,7 @@ and seekReadTypeDefOrRef ctxt numtypars boxity (ginst:ILTypes) (TaggedIndex(tag, | tag when tag = tdor_TypeDef -> seekReadTypeDefAsType ctxt boxity ginst idx | tag when tag = tdor_TypeRef -> seekReadTypeRefAsType ctxt boxity ginst idx | tag when tag = tdor_TypeSpec -> - if ginst.Length > 0 then dprintn ("type spec used as type constructor for a generic instantiation: ignoring instantiation"); + if ginst.Length > 0 then dprintn ("type spec used as type constructor for a generic instantiation: ignoring instantiation") readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt idx) | _ -> failwith "seekReadTypeDefOrRef ctxt" @@ -1870,7 +1869,7 @@ and seekReadTypeDefOrRefAsTypeRef ctxt (TaggedIndex(tag,idx) ) = | tag when tag = tdor_TypeDef -> seekReadTypeDefAsTypeRef ctxt idx | tag when tag = tdor_TypeRef -> seekReadTypeRef ctxt idx | tag when tag = tdor_TypeSpec -> - dprintn ("type spec used where a type ref or def ctxt.is required"); + dprintn ("type spec used where a type ref or def ctxt.is required") ctxt.ilg.tref_Object | _ -> failwith "seekReadTypeDefOrRefAsTypeRef_readTypeDefOrRefOrSpec" @@ -1896,7 +1895,7 @@ and seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(tag,idx)) = and seekReadMethodDefOrRefNoVarargs ctxt numtypars x = let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) = seekReadMethodDefOrRef ctxt numtypars x - if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"; + if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" MethodData(enclTyp, cc, nm, argtys, retty,minst) and seekReadCustomAttrType ctxt (TaggedIndex(tag,idx) ) = @@ -1937,21 +1936,21 @@ and seekReadField ctxt (numtypars, hasLayout) (idx:int) = let nm = readStringHeap ctxt nameIdx let isStatic = (flags &&& 0x0010) <> 0 let fd = - { Name = nm; - Type= readBlobHeapAsFieldSig ctxt numtypars typeIdx; - Access = memberAccessOfFlags flags; - IsStatic = isStatic; - IsInitOnly = (flags &&& 0x0020) <> 0; - IsLiteral = (flags &&& 0x0040) <> 0; - NotSerialized = (flags &&& 0x0080) <> 0; - IsSpecialName = (flags &&& 0x0200) <> 0 || (flags &&& 0x0400) <> 0; (* REVIEW: RTSpecialName *) - LiteralValue = if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_FieldDef,idx))); + { Name = nm + Type= readBlobHeapAsFieldSig ctxt numtypars typeIdx + Access = memberAccessOfFlags flags + IsStatic = isStatic + IsInitOnly = (flags &&& 0x0020) <> 0 + IsLiteral = (flags &&& 0x0040) <> 0 + NotSerialized = (flags &&& 0x0080) <> 0 + IsSpecialName = (flags &&& 0x0200) <> 0 || (flags &&& 0x0400) <> 0 (* REVIEW: RTSpecialName *) + LiteralValue = if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_FieldDef,idx))) Marshal = if (flags &&& 0x1000) = 0 then None else Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal,seekReadFieldMarshalRow ctxt, fst,hfmCompare (TaggedIndex(hfm_FieldDef,idx)), isSorted ctxt TableNames.FieldMarshal, - (snd >> readBlobHeapAsNativeType ctxt))); + (snd >> readBlobHeapAsNativeType ctxt))) Data = if (flags &&& 0x0100) = 0 then None else @@ -1961,8 +1960,8 @@ and seekReadField ctxt (numtypars, hasLayout) (idx:int) = Offset = if hasLayout && not isStatic then Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldLayout,seekReadFieldLayoutRow ctxt, - snd,simpleIndexCompare idx,isSorted ctxt TableNames.FieldLayout,fst)) else None; - CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_FieldDef,idx)); } + snd,simpleIndexCompare idx,isSorted ctxt TableNames.FieldLayout,fst)) else None + CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_FieldDef,idx)) } fd and seekReadFields ctxt (numtypars, hasLayout) fidx1 fidx2 = @@ -2056,13 +2055,13 @@ and sigptrGetTy ctxt numtypars bytes sigptr = elif b0 = et_FNPTR then let ccByte,sigptr = sigptrGetByte bytes sigptr let generic,cc = byteAsCallConv ccByte - if generic then failwith "fptr sig may not be generic"; + if generic then failwith "fptr sig may not be generic" let numparams,sigptr = sigptrGetZInt32 bytes sigptr let retty,sigptr = sigptrGetTy ctxt numtypars bytes sigptr let argtys,sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr ILType.FunctionPointer - { CallingConv=cc; - ArgTypes=mkILTypes argtys; + { CallingConv=cc + ArgTypes=mkILTypes argtys ReturnType=retty } ,sigptr elif b0 = et_SENTINEL then failwith "varargs NYI" @@ -2121,7 +2120,7 @@ and readBlobHeapAsFieldSigUncached ctxtH (BlobAsFieldSigIdx (numtypars,blobIdx)) let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 let ccByte,sigptr = sigptrGetByte bytes sigptr - if ccByte <> e_IMAGE_CEE_CS_CALLCONV_FIELD then dprintn "warning: field sig was not CC_FIELD"; + if ccByte <> e_IMAGE_CEE_CS_CALLCONV_FIELD then dprintn "warning: field sig was not CC_FIELD" let retty,_sigptr = sigptrGetTy ctxt numtypars bytes sigptr retty @@ -2135,7 +2134,7 @@ and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars,blobIdx let ccByte,sigptr = sigptrGetByte bytes sigptr let hasthis = byteAsHasThis ccByte let ccMaxked = (ccByte &&& 0x0Fuy) - if ccMaxked <> e_IMAGE_CEE_CS_CALLCONV_PROPERTY then dprintn ("warning: property sig was "+string ccMaxked+" instead of CC_PROPERTY"); + if ccMaxked <> e_IMAGE_CEE_CS_CALLCONV_PROPERTY then dprintn ("warning: property sig was "+string ccMaxked+" instead of CC_PROPERTY") let numparams,sigptr = sigptrGetZInt32 bytes sigptr let retty,sigptr = sigptrGetTy ctxt numtypars bytes sigptr let argtys,_sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr @@ -2149,7 +2148,7 @@ and readBlobHeapAsLocalsSigUncached ctxtH (BlobAsLocalSigIdx (numtypars,blobIdx) let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 let ccByte,sigptr = sigptrGetByte bytes sigptr - if ccByte <> e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG then dprintn "warning: local sig was not CC_LOCAL"; + if ccByte <> e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG then dprintn "warning: local sig was not CC_LOCAL" let numlocals,sigptr = sigptrGetZInt32 bytes sigptr let localtys,_sigptr = sigptrFold (sigptrGetLocal ctxt numtypars) ( numlocals) bytes sigptr localtys @@ -2185,7 +2184,7 @@ and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars, and seekReadMemberRefAsMethDataNoVarArgs ctxt numtypars idx : MethodData = let (VarArgMethodData(enclTyp, cc, nm, argtys,varargs, retty,minst)) = seekReadMemberRefAsMethodData ctxt numtypars idx - if isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"; + if isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" (MethodData(enclTyp, cc, nm, argtys, retty,minst)) and seekReadMethodSpecAsMethodData ctxt numtypars idx = @@ -2198,7 +2197,7 @@ and seekReadMethodSpecAsMethodDataUncached ctxtH (MethodSpecAsMspecIdx (numtypar let bytes = readBlobHeap ctxt instIdx let sigptr = 0 let ccByte,sigptr = sigptrGetByte bytes sigptr - if ccByte <> e_IMAGE_CEE_CS_CALLCONV_GENERICINST then dprintn ("warning: method inst ILCallingConv was "+string ccByte+" instead of CC_GENERICINST"); + if ccByte <> e_IMAGE_CEE_CS_CALLCONV_GENERICINST then dprintn ("warning: method inst ILCallingConv was "+string ccByte+" instead of CC_GENERICINST") let numgpars,sigptr = sigptrGetZInt32 bytes sigptr let argtys,_sigptr = sigptrFold (sigptrGetTy ctxt numtypars) numgpars bytes sigptr mkILTypes argtys @@ -2239,7 +2238,7 @@ and seekReadMethodDefAsMethodDataUncached ctxtH idx = true,fst) // Read the method def signature. let _generic,_genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt 0 typeIdx - if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"; + if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" // Create a formal instantiation if needed let finst = mkILFormalGenericArgsRaw (seekReadGenericParams ctxt 0 (tomd_TypeDef,tidx)) let minst = mkILFormalGenericArgsRaw (seekReadGenericParams ctxt finst.Length (tomd_MethodDef,idx)) @@ -2302,7 +2301,7 @@ and seekReadMethod ctxt numtypars (idx:int) = let cctor = (nm = ".cctor") let ctor = (nm = ".ctor") let _generic,_genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt numtypars typeIdx - if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef signature"; + if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef signature" let endParamIdx = if idx >= ctxt.getNumRows TableNames.Method then @@ -2313,49 +2312,49 @@ and seekReadMethod ctxt numtypars (idx:int) = let ret,ilParams = seekReadParams ctxt (retty,argtys) paramIdx endParamIdx - { Name=nm; + { Name=nm mdKind = (if cctor then MethodKind.Cctor elif ctor then MethodKind.Ctor elif isStatic then MethodKind.Static elif virt then MethodKind.Virtual - { IsFinal=final; - IsNewSlot=newslot; - IsCheckAccessOnOverride=strict; - IsAbstract=abstr; } - else MethodKind.NonVirtual); - Access = memberAccessOfFlags flags; - SecurityDecls=seekReadSecurityDecls ctxt (TaggedIndex(hds_MethodDef,idx)); - HasSecurity=hassec; - IsEntryPoint= (fst ctxt.entryPointToken = TableNames.Method && snd ctxt.entryPointToken = idx); - IsReqSecObj=reqsecobj; - IsHideBySig=hidebysig; - IsSpecialName=specialname; - IsUnmanagedExport=export; - IsSynchronized=synchronized; - IsNoInline=noinline; - IsMustRun=mustrun; - IsPreserveSig=preservesig; - IsManaged = not unmanaged; - IsInternalCall = internalcall; - IsForwardRef = forwardref; - mdCodeKind = (if (codetype = 0x00) then MethodCodeKind.IL elif (codetype = 0x01) then MethodCodeKind.Native elif (codetype = 0x03) then MethodCodeKind.Runtime else (dprintn "unsupported code type"; MethodCodeKind.Native)); - GenericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef,idx); - CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_MethodDef,idx)); - Parameters= ilParams; - CallingConv=cc; - Return=ret; + { IsFinal=final + IsNewSlot=newslot + IsCheckAccessOnOverride=strict + IsAbstract=abstr } + else MethodKind.NonVirtual) + Access = memberAccessOfFlags flags + SecurityDecls=seekReadSecurityDecls ctxt (TaggedIndex(hds_MethodDef,idx)) + HasSecurity=hassec + IsEntryPoint= (fst ctxt.entryPointToken = TableNames.Method && snd ctxt.entryPointToken = idx) + IsReqSecObj=reqsecobj + IsHideBySig=hidebysig + IsSpecialName=specialname + IsUnmanagedExport=export + IsSynchronized=synchronized + IsNoInline=noinline + IsMustRun=mustrun + IsPreserveSig=preservesig + IsManaged = not unmanaged + IsInternalCall = internalcall + IsForwardRef = forwardref + mdCodeKind = (if (codetype = 0x00) then MethodCodeKind.IL elif (codetype = 0x01) then MethodCodeKind.Native elif (codetype = 0x03) then MethodCodeKind.Runtime else MethodCodeKind.Native) + GenericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef,idx) + CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_MethodDef,idx)) + Parameters= ilParams + CallingConv=cc + Return=ret mdBody= if (codetype = 0x01) && pinvoke then mkMethBodyLazyAux (notlazy MethodBody.Native) elif pinvoke then seekReadImplMap ctxt nm idx elif internalcall || abstr || unmanaged || (codetype <> 0x00) then - if codeRVA <> 0x0 then dprintn "non-IL or abstract method with non-zero RVA"; + if codeRVA <> 0x0 then dprintn "non-IL or abstract method with non-zero RVA" mkMethBodyLazyAux (notlazy MethodBody.Abstract) else - seekReadMethodRVA ctxt (idx,nm,internalcall,noinline,numtypars) codeRVA; + seekReadMethodRVA ctxt (idx,nm,internalcall,noinline,numtypars) codeRVA } @@ -2365,13 +2364,13 @@ and seekReadParams ctxt (retty,argtys) pidx1 pidx2 = argtys |> ILList.toArray |> Array.map (fun ty -> - { Name=None; - Default=None; - Marshal=None; - IsIn=false; - IsOut=false; - IsOptional=false; - Type=ty; + { Name=None + Default=None + Marshal=None + IsIn=false + IsOut=false + IsOptional=false + Type=ty CustomAttrs=emptyILCustomAttrs }) for i = pidx1 to pidx2 - 1 do seekReadParamExtras ctxt (retRes,paramsRes) i @@ -2386,18 +2385,18 @@ and seekReadParamExtras ctxt (retRes,paramsRes) (idx:int) = let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_ParamDef,idx)) if seq = 0 then retRes := { !retRes with - Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef,idx))) else None); + Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef,idx))) else None) CustomAttrs = cas } elif seq > Array.length paramsRes then dprintn "bad seq num. for param" else paramsRes.[seq - 1] <- { paramsRes.[seq - 1] with - Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef,idx))) else None); - Default = (if hasDefault then Some (seekReadConstant ctxt (TaggedIndex(hc_ParamDef,idx))) else None); - Name = readStringHeapOption ctxt nameIdx; - IsIn = ((inOutMasked &&& 0x0001) <> 0x0); - IsOut = ((inOutMasked &&& 0x0002) <> 0x0); - IsOptional = ((inOutMasked &&& 0x0010) <> 0x0); + Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef,idx))) else None) + Default = (if hasDefault then Some (seekReadConstant ctxt (TaggedIndex(hc_ParamDef,idx))) else None) + Name = readStringHeapOption ctxt nameIdx + IsIn = ((inOutMasked &&& 0x0001) <> 0x0) + IsOut = ((inOutMasked &&& 0x0002) <> 0x0) + IsOptional = ((inOutMasked &&& 0x0010) <> 0x0) CustomAttrs =cas } and seekReadMethodImpls ctxt numtypars tidx = @@ -2407,7 +2406,7 @@ and seekReadMethodImpls ctxt numtypars tidx = mimpls |> List.map (fun (b,c) -> { OverrideBy= let (MethodData(enclTyp, cc, nm, argtys, retty,minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars b - mkILMethSpecInTyRaw (enclTyp, cc, nm, argtys, retty,minst); + mkILMethSpecInTyRaw (enclTyp, cc, nm, argtys, retty,minst) Overrides= let (MethodData(enclTyp, cc, nm, argtys, retty,minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars c let mspec = mkILMethSpecInTyRaw (enclTyp, cc, nm, argtys, retty,minst) @@ -2440,14 +2439,14 @@ and seekReadMethodSemantics ctxt id = and seekReadEvent ctxt numtypars idx = let (flags,nameIdx,typIdx) = seekReadEventRow ctxt idx - { Name = readStringHeap ctxt nameIdx; - Type = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject typIdx; - IsSpecialName = (flags &&& 0x0200) <> 0x0; - IsRTSpecialName = (flags &&& 0x0400) <> 0x0; - AddMethod= seekReadMethodSemantics ctxt (0x0008,TaggedIndex(hs_Event, idx)); - RemoveMethod=seekReadMethodSemantics ctxt (0x0010,TaggedIndex(hs_Event,idx)); - FireMethod=seekReadoptional_MethodSemantics ctxt (0x0020,TaggedIndex(hs_Event,idx)); - OtherMethods = seekReadMultipleMethodSemantics ctxt (0x0004, TaggedIndex(hs_Event, idx)); + { Name = readStringHeap ctxt nameIdx + Type = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject typIdx + IsSpecialName = (flags &&& 0x0200) <> 0x0 + IsRTSpecialName = (flags &&& 0x0400) <> 0x0 + AddMethod= seekReadMethodSemantics ctxt (0x0008,TaggedIndex(hs_Event, idx)) + RemoveMethod=seekReadMethodSemantics ctxt (0x0010,TaggedIndex(hs_Event,idx)) + FireMethod=seekReadoptional_MethodSemantics ctxt (0x0020,TaggedIndex(hs_Event,idx)) + OtherMethods = seekReadMultipleMethodSemantics ctxt (0x0004, TaggedIndex(hs_Event, idx)) CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Event,idx)) } (* REVIEW: can substantially reduce numbers of EventMap and PropertyMap reads by first checking if the whole table is sorted according to ILTypeDef tokens and then doing a binary chop *) @@ -2481,15 +2480,15 @@ and seekReadProperty ctxt numtypars idx = match setter with | Some mref -> mref.CallingConv .ThisConv | None -> cc - { Name=readStringHeap ctxt nameIdx; - CallingConv = cc2; - IsRTSpecialName=(flags &&& 0x0400) <> 0x0; - IsSpecialName= (flags &&& 0x0200) <> 0x0; - SetMethod=setter; - GetMethod=getter; - Type=retty; - Init= if (flags &&& 0x1000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_Property,idx))); - Args=argtys; + { Name=readStringHeap ctxt nameIdx + CallingConv = cc2 + IsRTSpecialName=(flags &&& 0x0400) <> 0x0 + IsSpecialName= (flags &&& 0x0200) <> 0x0 + SetMethod=setter + GetMethod=getter + Type=retty + Init= if (flags &&& 0x1000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_Property,idx))) + Args=argtys CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Property,idx)) } and seekReadProperties ctxt numtypars tidx = @@ -2523,7 +2522,7 @@ and seekReadCustomAttr ctxt (TaggedIndex(cat,idx),b) = and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat,idx,valIdx)) = let ctxt = getHole ctxtH - { Method=seekReadCustomAttrType ctxt (TaggedIndex(cat,idx)); + { Method=seekReadCustomAttrType ctxt (TaggedIndex(cat,idx)) Data= match readBlobHeapOption ctxt valIdx with | Some bytes -> bytes @@ -2611,16 +2610,16 @@ and seekReadImplMap ctxt nm midx = elif masked = 0x2000 then PInvokeThrowOnUnmappableChar.Disabled else (dprintn "strange ThrowOnUnmappableChar"; PInvokeThrowOnUnmappableChar.UseAssembly) - MethodBody.PInvoke { CallingConv = cc; - CharEncoding = enc; - CharBestFit=bestfit; - ThrowOnUnmappableChar=unmap; - NoMangle = (flags &&& 0x0001) <> 0x0; - LastError = (flags &&& 0x0040) <> 0x0; + MethodBody.PInvoke { CallingConv = cc + CharEncoding = enc + CharBestFit=bestfit + ThrowOnUnmappableChar=unmap + NoMangle = (flags &&& 0x0001) <> 0x0 + LastError = (flags &&& 0x0040) <> 0x0 Name = (match readStringHeapOption ctxt nameIdx with | None -> nm - | Some nm2 -> nm2); + | Some nm2 -> nm2) Where = seekReadModuleRef ctxt scopeIdx }) and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = @@ -2637,7 +2636,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = | Some l -> l | None -> let lab = generateCodeLabel() - labelsOfRawOffsets.[rawOffset] <- lab; + labelsOfRawOffsets.[rawOffset] <- lab lab let markAsInstructionStart rawOffset ilOffset = @@ -2651,12 +2650,12 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = let lastb2 = ref 0x0 let b = ref 0x0 let get () = - lastb := seekReadByteAsInt32 ctxt.is (start + (!curr)); - incr curr; + lastb := seekReadByteAsInt32 ctxt.is (start + (!curr)) + incr curr b := if !lastb = 0xfe && !curr < sz then - lastb2 := seekReadByteAsInt32 ctxt.is (start + (!curr)); - incr curr; + lastb2 := seekReadByteAsInt32 ctxt.is (start + (!curr)) + incr curr !lastb2 else !lastb @@ -2665,7 +2664,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = while !curr < sz do // registering "+string !curr+" as start of an instruction") - markAsInstructionStart !curr ibuf.Count; + markAsInstructionStart !curr ibuf.Count // Insert any sequence points into the instruction sequence while @@ -2675,17 +2674,17 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = do // Emitting one sequence point let (_,tag) = List.head !seqPointsRemaining - seqPointsRemaining := List.tail !seqPointsRemaining; + seqPointsRemaining := List.tail !seqPointsRemaining ibuf.Add (I_seqpoint tag) // Read the prefixes. Leave lastb and lastb2 holding the instruction byte(s) begin - prefixes.al <- Aligned; - prefixes.tl <- Normalcall; - prefixes.vol <- Nonvolatile; - prefixes.ro<-NormalAddress; - prefixes.constrained<-None; - get (); + prefixes.al <- Aligned + prefixes.tl <- Normalcall + prefixes.vol <- Nonvolatile + prefixes.ro<-NormalAddress + prefixes.constrained<-None + get () while !curr < sz && !lastb = 0xfe && (!b = (i_constrained &&& 0xff) || @@ -2696,7 +2695,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = begin if !b = (i_unaligned &&& 0xff) then let unal = seekReadByteAsInt32 ctxt.is (start + (!curr)) - incr curr; + incr curr prefixes.al <- if unal = 0x1 then Unaligned1 elif unal = 0x2 then Unaligned2 @@ -2706,17 +2705,16 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = elif !b = (i_readonly &&& 0xff) then prefixes.ro <- ReadonlyAddress elif !b = (i_constrained &&& 0xff) then let uncoded = seekReadUncodedToken ctxt.is (start + (!curr)) - curr := !curr + 4; + curr := !curr + 4 let typ = seekReadTypeDefOrRef ctxt numtypars AsObject ILList.empty (uncodedTokenToTypeDefOrRefOrSpec uncoded) prefixes.constrained <- Some typ - else prefixes.tl <- Tailcall; - end; - get (); - done; - end; + else prefixes.tl <- Tailcall + end + get () + end // data for instruction begins at "+string !curr - (* Read and decode the instruction *) + // Read and decode the instruction if (!curr <= sz) then let idecoder = if !lastb = 0xfe then getTwoByteInstr ( !lastb2) @@ -2725,37 +2723,37 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = match idecoder with | I_u16_u8_instr f -> let x = seekReadByte ctxt.is (start + (!curr)) |> uint16 - curr := !curr + 1; + curr := !curr + 1 f prefixes x | I_u16_u16_instr f -> let x = seekReadUInt16 ctxt.is (start + (!curr)) - curr := !curr + 2; + curr := !curr + 2 f prefixes x | I_none_instr f -> f prefixes | I_i64_instr f -> let x = seekReadInt64 ctxt.is (start + (!curr)) - curr := !curr + 8; + curr := !curr + 8 f prefixes x | I_i32_i8_instr f -> let x = seekReadSByte ctxt.is (start + (!curr)) |> int32 - curr := !curr + 1; + curr := !curr + 1 f prefixes x | I_i32_i32_instr f -> let x = seekReadInt32 ctxt.is (start + (!curr)) - curr := !curr + 4; + curr := !curr + 4 f prefixes x | I_r4_instr f -> let x = seekReadSingle ctxt.is (start + (!curr)) - curr := !curr + 4; + curr := !curr + 4 f prefixes x | I_r8_instr f -> let x = seekReadDouble ctxt.is (start + (!curr)) - curr := !curr + 8; + curr := !curr + 8 f prefixes x | I_field_instr f -> let (tab,tok) = seekReadUncodedToken ctxt.is (start + (!curr)) - curr := !curr + 4; + curr := !curr + 4 let fspec = if tab = TableNames.Field then seekReadFieldDefAsFieldSpec ctxt tok @@ -2767,7 +2765,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = // method instruction, curr = "+string !curr let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) - curr := !curr + 4; + curr := !curr + 4 let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) = if tab = TableNames.Method then seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(mdor_MethodDef, idx)) @@ -2789,39 +2787,41 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = f prefixes (mspec,varargs) | I_type_instr f -> let uncoded = seekReadUncodedToken ctxt.is (start + (!curr)) - curr := !curr + 4; + curr := !curr + 4 let typ = seekReadTypeDefOrRef ctxt numtypars AsObject ILList.empty (uncodedTokenToTypeDefOrRefOrSpec uncoded) f prefixes typ | I_string_instr f -> let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) - curr := !curr + 4; - if tab <> TableNames.UserStrings then dprintn "warning: bad table in user string for ldstr"; + curr := !curr + 4 + if tab <> TableNames.UserStrings then dprintn "warning: bad table in user string for ldstr" f prefixes (readUserStringHeap ctxt (idx)) | I_conditional_i32_instr f -> let offsDest = (seekReadInt32 ctxt.is (start + (!curr))) - curr := !curr + 4; + curr := !curr + 4 let dest = !curr + offsDest f prefixes (rawToLabel dest) | I_conditional_i8_instr f -> let offsDest = int (seekReadSByte ctxt.is (start + (!curr))) - curr := !curr + 1; + curr := !curr + 1 let dest = !curr + offsDest f prefixes (rawToLabel dest) | I_unconditional_i32_instr f -> let offsDest = (seekReadInt32 ctxt.is (start + (!curr))) - curr := !curr + 4; + curr := !curr + 4 let dest = !curr + offsDest f prefixes (rawToLabel dest) | I_unconditional_i8_instr f -> let offsDest = int (seekReadSByte ctxt.is (start + (!curr))) - curr := !curr + 1; + curr := !curr + 1 let dest = !curr + offsDest f prefixes (rawToLabel dest) - | I_invalid_instr -> dprintn ("invalid instruction: "+string !lastb+ (if !lastb = 0xfe then ","+string !lastb2 else "")); I_ret + | I_invalid_instr -> + dprintn ("invalid instruction: "+string !lastb+ (if !lastb = 0xfe then ","+string !lastb2 else "")) + I_ret | I_tok_instr f -> let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) - curr := !curr + 4; + curr := !curr + 4 (* REVIEW: this incorrectly labels all MemberRef tokens as ILMethod's: we should go look at the MemberRef sig to determine if it is a field or method *) let token_info = if tab = TableNames.Method || tab = TableNames.MemberRef (* REVIEW:generics or tab = TableNames.MethodSpec *) then @@ -2835,25 +2835,25 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = f prefixes token_info | I_sig_instr f -> let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) - curr := !curr + 4; - if tab <> TableNames.StandAloneSig then dprintn "strange table for callsig token"; + curr := !curr + 4 + if tab <> TableNames.StandAloneSig then dprintn "strange table for callsig token" let generic,_genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt numtypars (seekReadStandAloneSigRow ctxt idx) - if generic then failwith "bad image: a generic method signature ctxt.is begin used at a calli instruction"; + if generic then failwith "bad image: a generic method signature ctxt.is begin used at a calli instruction" f prefixes (mkILCallSigRaw (cc,argtys,retty), varargs) | I_switch_instr f -> let n = (seekReadInt32 ctxt.is (start + (!curr))) - curr := !curr + 4; + curr := !curr + 4 let offsets = List.init n (fun _ -> let i = (seekReadInt32 ctxt.is (start + (!curr))) - curr := !curr + 4; + curr := !curr + 4 i) let dests = List.map (fun offs -> rawToLabel (!curr + offs)) offsets f prefixes dests ibuf.Add instr - done; + done // Finished reading instructions - mark the end of the instruction stream in case the PDB information refers to it. - markAsInstructionStart !curr ibuf.Count; + markAsInstructionStart !curr ibuf.Count // Build the function that maps from raw labels (offsets into the bytecode stream) to indexes in the AbsIL instruction stream let lab2pc = ilOffsetsOfLabels @@ -2898,7 +2898,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = let pdbm = pdbReaderGetMethod pdbr (uncodedToken TableNames.Method idx) //let rootScope = pdbMethodGetRootScope pdbm let sps = pdbMethodGetSequencePoints pdbm - (*dprintf "#sps for 0x%x = %d\n" (uncodedToken TableNames.Method idx) (Array.length sps); *) + (*dprintf "#sps for 0x%x = %d\n" (uncodedToken TableNames.Method idx) (Array.length sps) *) (* let roota,rootb = pdbScopeGetOffsets rootScope in *) let seqpoints = let arr = @@ -2913,7 +2913,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = endColumn = sp.pdbSeqPointEndColumn) (sp.pdbSeqPointOffset,source)) - Array.sortInPlaceBy fst arr; + Array.sortInPlaceBy fst arr Array.toList arr let rec scopes scp = @@ -2929,12 +2929,12 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = ilvs |> List.map (fun ilv -> let _k,idx = pdbVariableGetAddressAttributes ilv let n = pdbVariableGetName ilv - { LocalIndex= idx; + { LocalIndex= idx LocalName=n}) let thisOne = (fun raw2nextLab -> - { Range= (raw2nextLab a,raw2nextLab b); + { Range= (raw2nextLab a,raw2nextLab b) DebugMappings = ilinfos } : ILLocalDebugInfo ) let others = List.foldBack (scopes >> (@)) (Array.toList (pdbScopeGetChildren scp)) [] thisOne :: others @@ -2952,17 +2952,17 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = if (b &&& e_CorILMethod_FormatMask) = e_CorILMethod_TinyFormat then let codeBase = baseRVA + 1 let codeSize = (int32 b >>>& 2) - // tiny format for "+nm+", code size = " + string codeSize); + // tiny format for "+nm+", code size = " + string codeSize) let instrs,_,lab2pc,raw2nextLab = seekReadTopCode ctxt numtypars codeSize codeBase seqpoints (* Convert the linear code format to the nested code format *) let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos let code = buildILCode nm lab2pc instrs [] localPdbInfos2 MethodBody.IL - { IsZeroInit=false; - MaxStack= 8; - NoInlining=noinline; - Locals=ILList.empty; - SourceMarker=methRangePdbInfo; + { IsZeroInit=false + MaxStack= 8 + NoInlining=noinline + Locals=ILList.empty + SourceMarker=methRangePdbInfo Code=code } elif (b &&& e_CorILMethod_FormatMask) = e_CorILMethod_FatFormat then @@ -2975,10 +2975,10 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = let locals = if localToken = 0x0 then [] else - if localsTab <> TableNames.StandAloneSig then dprintn "strange table for locals token"; + if localsTab <> TableNames.StandAloneSig then dprintn "strange table for locals token" readBlobHeapAsLocalsSig ctxt numtypars (seekReadStandAloneSigRow ctxt localToken) - // fat format for "+nm+", code size = " + string codeSize+", hasMoreSections = "+(if hasMoreSections then "true" else "false")+",b = "+string b); + // fat format for "+nm+", code size = " + string codeSize+", hasMoreSections = "+(if hasMoreSections then "true" else "false")+",b = "+string b) // Read the method body let instrs,rawToLabel,lab2pc,raw2nextLab = seekReadTopCode ctxt numtypars ( codeSize) codeBase seqpoints @@ -2991,11 +2991,11 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = while !moreSections do let sectionBase = !nextSectionBase let sectionFlag = seekReadByte ctxt.is sectionBase - // fat format for "+nm+", sectionFlag = " + string sectionFlag); + // fat format for "+nm+", sectionFlag = " + string sectionFlag) let sectionSize, clauses = if (sectionFlag &&& e_CorILMethod_Sect_FatFormat) <> 0x0uy then let bigSize = (seekReadInt32 ctxt.is sectionBase) >>>& 8 - // bigSize = "+string bigSize); + // bigSize = "+string bigSize) let clauses = if (sectionFlag &&& e_CorILMethod_Sect_EHTable) <> 0x0uy then // WORKAROUND: The ECMA spec says this should be @@ -3022,11 +3022,11 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = // let numClauses = ((smallSize - 4) / 12) in // but the C# compiler (or some IL generator) generates multiples of 12 let numClauses = (smallSize / 12) - // dprintn (nm+" has " + string numClauses + " tiny seh clauses"); + // dprintn (nm+" has " + string numClauses + " tiny seh clauses") List.init numClauses (fun i -> let clauseBase = sectionBase + 4 + (i * 12) let kind = seekReadUInt16AsInt32 ctxt.is (clauseBase + 0) - if logging then dprintn ("One tiny SEH clause, kind = "+string kind); + if logging then dprintn ("One tiny SEH clause, kind = "+string kind) let st1 = seekReadUInt16AsInt32 ctxt.is (clauseBase + 2) let sz1 = seekReadByteAsInt32 ctxt.is (clauseBase + 4) let st2 = seekReadUInt16AsInt32 ctxt.is (clauseBase + 5) @@ -3059,7 +3059,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = elif kind = e_COR_ILEXCEPTION_CLAUSE_FAULT then ILExceptionClause.Fault(handlerStart, handlerFinish) else begin - dprintn (ctxt.infile + ": unknown exception handler kind: "+string kind); + dprintn (ctxt.infile + ": unknown exception handler kind: "+string kind) ILExceptionClause.Finally(handlerStart, handlerFinish) end @@ -3069,28 +3069,28 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = sehMap.[key] <- (prev @ [clause]) else sehMap.[key] <- [clause]) - clauses; + clauses ([],sehMap) ||> Seq.fold (fun acc (KeyValue(key,bs)) -> [ for b in bs -> {Range=key; Clause=b} : ILExceptionSpec ] @ acc) - seh := sehClauses; - moreSections := (sectionFlag &&& e_CorILMethod_Sect_MoreSects) <> 0x0uy; - nextSectionBase := sectionBase + sectionSize; - done; (* while *) + seh := sehClauses + moreSections := (sectionFlag &&& e_CorILMethod_Sect_MoreSects) <> 0x0uy + nextSectionBase := sectionBase + sectionSize + done (* while *) (* Convert the linear code format to the nested code format *) - if logging then dprintn ("doing localPdbInfos2"); + if logging then dprintn ("doing localPdbInfos2") let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos - if logging then dprintn ("done localPdbInfos2, checking code..."); + if logging then dprintn ("done localPdbInfos2, checking code...") let code = buildILCode nm lab2pc instrs !seh localPdbInfos2 - if logging then dprintn ("done checking code."); + if logging then dprintn ("done checking code.") MethodBody.IL - { IsZeroInit=initlocals; - MaxStack= maxstack; - NoInlining=noinline; - Locals=mkILLocals locals; - Code=code; + { IsZeroInit=initlocals + MaxStack= maxstack + NoInlining=noinline + Locals=mkILLocals locals + Code=code SourceMarker=methRangePdbInfo} else - if logging then failwith "unknown format"; + if logging then failwith "unknown format" MethodBody.Abstract end) @@ -3103,36 +3103,36 @@ and int32AsILVariantType ctxt (n:int32) = else (dprintn (ctxt.infile + ": int32AsILVariantType ctxt: unexpected variant type, n = "+string n) ; ILNativeVariant.Empty) and readBlobHeapAsNativeType ctxt blobIdx = - // reading native type blob "+string blobIdx); + // reading native type blob "+string blobIdx) let bytes = readBlobHeap ctxt blobIdx let res,_ = sigptrGetILNativeType ctxt bytes 0 res and sigptrGetILNativeType ctxt bytes sigptr = - // reading native type blob, sigptr= "+string sigptr); + // reading native type blob, sigptr= "+string sigptr) let ntbyte,sigptr = sigptrGetByte bytes sigptr if List.memAssoc ntbyte (Lazy.force ILNativeTypeMap) then List.assoc ntbyte (Lazy.force ILNativeTypeMap), sigptr elif ntbyte = 0x0uy then ILNativeType.Empty, sigptr elif ntbyte = nt_CUSTOMMARSHALER then - // reading native type blob (CM1) , sigptr= "+string sigptr+ ", bytes.Length = "+string bytes.Length); + // reading native type blob (CM1) , sigptr= "+string sigptr+ ", bytes.Length = "+string bytes.Length) let guidLen,sigptr = sigptrGetZInt32 bytes sigptr - // reading native type blob (CM2) , sigptr= "+string sigptr+", guidLen = "+string ( guidLen)); + // reading native type blob (CM2) , sigptr= "+string sigptr+", guidLen = "+string ( guidLen)) let guid,sigptr = sigptrGetBytes ( guidLen) bytes sigptr - // reading native type blob (CM3) , sigptr= "+string sigptr); + // reading native type blob (CM3) , sigptr= "+string sigptr) let nativeTypeNameLen,sigptr = sigptrGetZInt32 bytes sigptr - // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeNameLen = "+string ( nativeTypeNameLen)); + // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeNameLen = "+string ( nativeTypeNameLen)) let nativeTypeName,sigptr = sigptrGetString ( nativeTypeNameLen) bytes sigptr - // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeName = "+nativeTypeName); - // reading native type blob (CM5) , sigptr= "+string sigptr); + // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeName = "+nativeTypeName) + // reading native type blob (CM5) , sigptr= "+string sigptr) let custMarshallerNameLen,sigptr = sigptrGetZInt32 bytes sigptr - // reading native type blob (CM6) , sigptr= "+string sigptr+", custMarshallerNameLen = "+string ( custMarshallerNameLen)); + // reading native type blob (CM6) , sigptr= "+string sigptr+", custMarshallerNameLen = "+string ( custMarshallerNameLen)) let custMarshallerName,sigptr = sigptrGetString ( custMarshallerNameLen) bytes sigptr - // reading native type blob (CM7) , sigptr= "+string sigptr+", custMarshallerName = "+custMarshallerName); + // reading native type blob (CM7) , sigptr= "+string sigptr+", custMarshallerName = "+custMarshallerName) let cookieStringLen,sigptr = sigptrGetZInt32 bytes sigptr - // reading native type blob (CM8) , sigptr= "+string sigptr+", cookieStringLen = "+string ( cookieStringLen)); + // reading native type blob (CM8) , sigptr= "+string sigptr+", cookieStringLen = "+string ( cookieStringLen)) let cookieString,sigptr = sigptrGetBytes ( cookieStringLen) bytes sigptr - // reading native type blob (CM9) , sigptr= "+string sigptr); + // reading native type blob (CM9) , sigptr= "+string sigptr) ILNativeType.Custom (guid,nativeTypeName,custMarshallerName,cookieString), sigptr elif ntbyte = nt_FIXEDSYSSTRING then let i,sigptr = sigptrGetZInt32 bytes sigptr @@ -3173,7 +3173,7 @@ and sigptrGetILNativeType ctxt bytes sigptr = if sigptr >= bytes.Length then 0, sigptr else sigptrGetZInt32 bytes sigptr ILNativeType.Array (Some nt,Some(pnum,Some(additive))), sigptr - else (dprintn (ctxt.infile + ": unexpected native type, nt = "+string ntbyte); ILNativeType.Empty, sigptr) + else (ILNativeType.Empty, sigptr) and seekReadManifestResources ctxt () = mkILResourcesLazy @@ -3191,9 +3191,9 @@ and seekReadManifestResources ctxt () = | ILScopeRef.Assembly aref -> ILResourceLocation.Assembly aref let r = - { Name= readStringHeap ctxt nameIdx; - Location = datalab; - Access = (if (flags &&& 0x01) <> 0x0 then ILResourceAccess.Public else ILResourceAccess.Private); + { Name= readStringHeap ctxt nameIdx + Location = datalab + Access = (if (flags &&& 0x01) <> 0x0 then ILResourceAccess.Public else ILResourceAccess.Private) CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_ManifestResource, i)) } yield r ]) @@ -3211,9 +3211,9 @@ and seekReadNestedExportedTypes ctxt parentIdx = | tag when tag = i_ExportedType && idx = parentIdx -> let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) yield - { Name=nm; - Access=(match typeAccessOfFlags flags with ILTypeDefAccess.Nested n -> n | _ -> failwith "non-nested access for a nested type described as being in an auxiliary module"); - Nested=seekReadNestedExportedTypes ctxt i; + { Name=nm + Access=(match typeAccessOfFlags flags with ILTypeDefAccess.Nested n -> n | _ -> failwith "non-nested access for a nested type described as being in an auxiliary module") + Nested=seekReadNestedExportedTypes ctxt i CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_ExportedType, i)) } | _ -> () ]) @@ -3233,14 +3233,14 @@ and seekReadTopExportedTypes ctxt () = let scoref = seekReadImplAsScopeRef ctxt implIdx let entry = - { ScopeRef=scoref; - Name=nm; - IsForwarder = ((flags &&& 0x00200000) <> 0); - Access=typeAccessOfFlags flags; - Nested=seekReadNestedExportedTypes ctxt i; + { ScopeRef=scoref + Name=nm + IsForwarder = ((flags &&& 0x00200000) <> 0) + Access=typeAccessOfFlags flags + Nested=seekReadNestedExportedTypes ctxt i CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_ExportedType, i)) } - res := entry :: !res; - done; + res := entry :: !res + done List.rev !res) #if FX_NO_PDB_READER @@ -3260,7 +3260,7 @@ let getPdbReader opts infile = ILSourceDocument.Create(language=Some (pdbDocumentGetLanguage pdbdoc), vendor = Some (pdbDocumentGetLanguageVendor pdbdoc), documentType = Some (pdbDocumentGetType pdbdoc), - file = url)); + file = url)) let docfun url = if tab.ContainsKey url then tab.[url] else failwith ("Document with URL "+url+" not found in list of documents in the PDB file") Some (pdbr, docfun) @@ -3281,7 +3281,7 @@ let rec genOpenBinaryReader infile is opts = let peFileHeaderPhysLoc = peSignaturePhysLoc + 0x04 let peOptionalHeaderPhysLoc = peFileHeaderPhysLoc + 0x14 let peSignature = seekReadInt32 is (peSignaturePhysLoc + 0) - if peSignature <> 0x4550 then failwithf "not a PE file - bad magic PE number 0x%08x, is = %A" peSignature is; + if peSignature <> 0x4550 then failwithf "not a PE file - bad magic PE number 0x%08x, is = %A" peSignature is (* PE SIGNATURE *) @@ -3289,7 +3289,7 @@ let rec genOpenBinaryReader infile is opts = let numSections = seekReadUInt16AsInt32 is (peFileHeaderPhysLoc + 2) let optHeaderSize = seekReadUInt16AsInt32 is (peFileHeaderPhysLoc + 16) if optHeaderSize <> 0xe0 && - optHeaderSize <> 0xf0 then failwith "not a PE file - bad optional header size"; + optHeaderSize <> 0xf0 then failwith "not a PE file - bad optional header size" let x64adjust = optHeaderSize - 0xe0 let only64 = (optHeaderSize = 0xf0) (* May want to read in the optional header Magic number and check that as well... *) let platform = match machine with | 0x8664 -> Some(AMD64) | 0x200 -> Some(IA64) | _ -> Some(X86) @@ -3389,16 +3389,16 @@ let rec genOpenBinaryReader infile is opts = let textSegmentPhysicalSize = if textHeaderStart = 0x0 then 0x0 else seekReadInt32 is (textHeaderStart + 16) let textSegmentPhysicalLoc = if textHeaderStart = 0x0 then 0x0 else seekReadInt32 is (textHeaderStart + 20) - if logging then dprintn (infile + ": textHeaderStart = "+string textHeaderStart); - if logging then dprintn (infile + ": dataHeaderStart = "+string dataHeaderStart); - if logging then dprintn (infile + ": dataSegmentAddr (pre section crack) = "+string dataSegmentAddr); + if logging then dprintn (infile + ": textHeaderStart = "+string textHeaderStart) + if logging then dprintn (infile + ": dataHeaderStart = "+string dataHeaderStart) + if logging then dprintn (infile + ": dataSegmentAddr (pre section crack) = "+string dataSegmentAddr) let dataSegmentSize = if dataHeaderStart = 0x0 then 0x0 else seekReadInt32 is (dataHeaderStart + 8) let dataSegmentAddr = if dataHeaderStart = 0x0 then 0x0 else seekReadInt32 is (dataHeaderStart + 12) let dataSegmentPhysicalSize = if dataHeaderStart = 0x0 then 0x0 else seekReadInt32 is (dataHeaderStart + 16) let dataSegmentPhysicalLoc = if dataHeaderStart = 0x0 then 0x0 else seekReadInt32 is (dataHeaderStart + 20) - if logging then dprintn (infile + ": dataSegmentAddr (post section crack) = "+string dataSegmentAddr); + if logging then dprintn (infile + ": dataSegmentAddr (post section crack) = "+string dataSegmentAddr) let anyV2P (n,v) = let rec look i pos = @@ -3411,11 +3411,11 @@ let rec genOpenBinaryReader infile is opts = else look (i+1) (pos + 0x28) look 0 sectionHeadersStartPhysLoc - if logging then dprintn (infile + ": numSections = "+string numSections); - if logging then dprintn (infile + ": cliHeaderAddr = "+string cliHeaderAddr); - if logging then dprintn (infile + ": cliHeaderPhys = "+string (anyV2P ("cli header",cliHeaderAddr))); - if logging then dprintn (infile + ": dataSegmentSize = "+string dataSegmentSize); - if logging then dprintn (infile + ": dataSegmentAddr = "+string dataSegmentAddr); + if logging then dprintn (infile + ": numSections = "+string numSections) + if logging then dprintn (infile + ": cliHeaderAddr = "+string cliHeaderAddr) + if logging then dprintn (infile + ": cliHeaderPhys = "+string (anyV2P ("cli header",cliHeaderAddr))) + if logging then dprintn (infile + ": dataSegmentSize = "+string dataSegmentSize) + if logging then dprintn (infile + ": dataSegmentAddr = "+string dataSegmentAddr) let cliHeaderPhysLoc = anyV2P ("cli header",cliHeaderAddr) @@ -3439,17 +3439,17 @@ let rec genOpenBinaryReader infile is opts = let vtableFixupsAddr = seekReadInt32 is (cliHeaderPhysLoc + 40) let _vtableFixupsSize = seekReadInt32 is (cliHeaderPhysLoc + 44) - if logging then dprintn (infile + ": metadataAddr = "+string metadataAddr); - if logging then dprintn (infile + ": resourcesAddr = "+string resourcesAddr); - if logging then dprintn (infile + ": resourcesSize = "+string resourcesSize); - if logging then dprintn (infile + ": nativeResourcesAddr = "+string nativeResourcesAddr); - if logging then dprintn (infile + ": nativeResourcesSize = "+string nativeResourcesSize); + if logging then dprintn (infile + ": metadataAddr = "+string metadataAddr) + if logging then dprintn (infile + ": resourcesAddr = "+string resourcesAddr) + if logging then dprintn (infile + ": resourcesSize = "+string resourcesSize) + if logging then dprintn (infile + ": nativeResourcesAddr = "+string nativeResourcesAddr) + if logging then dprintn (infile + ": nativeResourcesSize = "+string nativeResourcesSize) let metadataPhysLoc = anyV2P ("metadata",metadataAddr) let magic = seekReadUInt16AsInt32 is metadataPhysLoc - if magic <> 0x5342 then failwith (infile + ": bad metadata magic number: " + string magic); + if magic <> 0x5342 then failwith (infile + ": bad metadata magic number: " + string magic) let magic2 = seekReadUInt16AsInt32 is (metadataPhysLoc + 2) - if magic2 <> 0x424a then failwith "bad metadata magic number"; + if magic2 <> 0x424a then failwith "bad metadata magic number" let _majorMetadataVersion = seekReadUInt16 is (metadataPhysLoc + 4) let _minorMetadataVersion = seekReadUInt16 is (metadataPhysLoc + 6) @@ -3459,8 +3459,8 @@ let rec genOpenBinaryReader infile is opts = let numStreams = seekReadUInt16AsInt32 is (metadataPhysLoc + x + 2) let streamHeadersStart = (metadataPhysLoc + x + 4) - if logging then dprintn (infile + ": numStreams = "+string numStreams); - if logging then dprintn (infile + ": streamHeadersStart = "+string streamHeadersStart); + if logging then dprintn (infile + ": numStreams = "+string numStreams) + if logging then dprintn (infile + ": streamHeadersStart = "+string streamHeadersStart) (* Crack stream headers *) @@ -3479,7 +3479,7 @@ let rec genOpenBinaryReader infile is opts = if c = 0 then fin := true elif !n >= Array.length name || c <> name.[!n] then - res := false; + res := false incr n if !res then Some(offset + metadataPhysLoc,length) else look (i+1) (align 0x04 (pos + 8 + (!n))) @@ -3490,14 +3490,14 @@ let rec genOpenBinaryReader infile is opts = | None -> (0x0, 0x0) | Some positions -> positions - let (tablesStreamPhysLoc, tablesStreamSize) = + let (tablesStreamPhysLoc, _tablesStreamSize) = match tryFindStream [| 0x23; 0x7e |] (* #~ *) with | Some res -> res | None -> match tryFindStream [| 0x23; 0x2d |] (* #-: at least one DLL I've seen uses this! *) with | Some res -> res | None -> - dprintf "no metadata tables found under stream names '#~' or '#-', please report this\n"; + dprintf "no metadata tables found under stream names '#~' or '#-', please report this\n" let firstStreamOffset = seekReadInt32 is (streamHeadersStart + 0) let firstStreamLength = seekReadInt32 is (streamHeadersStart + 4) firstStreamOffset,firstStreamLength @@ -3507,84 +3507,71 @@ let rec genOpenBinaryReader infile is opts = let (guidsStreamPhysicalLoc, _guidsStreamSize) = findStream [| 0x23; 0x47; 0x55; 0x49; 0x44; |] (* #GUID *) let (blobsStreamPhysicalLoc, blobsStreamSize) = findStream [| 0x23; 0x42; 0x6c; 0x6f; 0x62; |] (* #Blob *) - if logging then dprintn (infile + ": tablesAddr = "+string tablesStreamPhysLoc); - if logging then dprintn (infile + ": tablesSize = "+string tablesStreamSize); - if logging then dprintn (infile + ": stringsAddr = "+string stringsStreamPhysicalLoc); - if logging then dprintn (infile + ": stringsSize = "+string stringsStreamSize); - if logging then dprintn (infile + ": user_stringsAddr = "+string userStringsStreamPhysicalLoc); - if logging then dprintn (infile + ": guidsAddr = "+string guidsStreamPhysicalLoc); - if logging then dprintn (infile + ": blobsAddr = "+string blobsStreamPhysicalLoc); - - let tables_streamMajor_version = seekReadByteAsInt32 is (tablesStreamPhysLoc + 4) - let tables_streamMinor_version = seekReadByteAsInt32 is (tablesStreamPhysLoc + 5) - - let usingWhidbeyBeta1TableSchemeForGenericParam = (tables_streamMajor_version = 1) && (tables_streamMinor_version = 1) - let tableKinds = - [|kindModule (* Table 0 *); - kindTypeRef (* Table 1 *); - kindTypeDef (* Table 2 *); - kindIllegal (* kindFieldPtr *) (* Table 3 *); - kindFieldDef (* Table 4 *); - kindIllegal (* kindMethodPtr *) (* Table 5 *); - kindMethodDef (* Table 6 *); - kindIllegal (* kindParamPtr *) (* Table 7 *); - kindParam (* Table 8 *); - kindInterfaceImpl (* Table 9 *); - kindMemberRef (* Table 10 *); - kindConstant (* Table 11 *); - kindCustomAttribute (* Table 12 *); - kindFieldMarshal (* Table 13 *); - kindDeclSecurity (* Table 14 *); - kindClassLayout (* Table 15 *); - kindFieldLayout (* Table 16 *); - kindStandAloneSig (* Table 17 *); - kindEventMap (* Table 18 *); - kindIllegal (* kindEventPtr *) (* Table 19 *); - kindEvent (* Table 20 *); - kindPropertyMap (* Table 21 *); - kindIllegal (* kindPropertyPtr *) (* Table 22 *); - kindProperty (* Table 23 *); - kindMethodSemantics (* Table 24 *); - kindMethodImpl (* Table 25 *); - kindModuleRef (* Table 26 *); - kindTypeSpec (* Table 27 *); - kindImplMap (* Table 28 *); - kindFieldRVA (* Table 29 *); - kindIllegal (* kindENCLog *) (* Table 30 *); - kindIllegal (* kindENCMap *) (* Table 31 *); - kindAssembly (* Table 32 *); - kindIllegal (* kindAssemblyProcessor *) (* Table 33 *); - kindIllegal (* kindAssemblyOS *) (* Table 34 *); - kindAssemblyRef (* Table 35 *); - kindIllegal (* kindAssemblyRefProcessor *) (* Table 36 *); - kindIllegal (* kindAssemblyRefOS *) (* Table 37 *); - kindFileRef (* Table 38 *); - kindExportedType (* Table 39 *); - kindManifestResource (* Table 40 *); - kindNested (* Table 41 *); - (if usingWhidbeyBeta1TableSchemeForGenericParam then kindGenericParam_v1_1 else kindGenericParam_v2_0); (* Table 42 *) - kindMethodSpec (* Table 43 *); - kindGenericParamConstraint (* Table 44 *); - kindIllegal (* Table 45 *); - kindIllegal (* Table 46 *); - kindIllegal (* Table 47 *); - kindIllegal (* Table 48 *); - kindIllegal (* Table 49 *); - kindIllegal (* Table 50 *); - kindIllegal (* Table 51 *); - kindIllegal (* Table 52 *); - kindIllegal (* Table 53 *); - kindIllegal (* Table 54 *); - kindIllegal (* Table 55 *); - kindIllegal (* Table 56 *); - kindIllegal (* Table 57 *); - kindIllegal (* Table 58 *); - kindIllegal (* Table 59 *); - kindIllegal (* Table 60 *); - kindIllegal (* Table 61 *); - kindIllegal (* Table 62 *); - kindIllegal (* Table 63 *); + [|kindModule (* Table 0 *) + kindTypeRef (* Table 1 *) + kindTypeDef (* Table 2 *) + kindIllegal (* kindFieldPtr *) (* Table 3 *) + kindFieldDef (* Table 4 *) + kindIllegal (* kindMethodPtr *) (* Table 5 *) + kindMethodDef (* Table 6 *) + kindIllegal (* kindParamPtr *) (* Table 7 *) + kindParam (* Table 8 *) + kindInterfaceImpl (* Table 9 *) + kindMemberRef (* Table 10 *) + kindConstant (* Table 11 *) + kindCustomAttribute (* Table 12 *) + kindFieldMarshal (* Table 13 *) + kindDeclSecurity (* Table 14 *) + kindClassLayout (* Table 15 *) + kindFieldLayout (* Table 16 *) + kindStandAloneSig (* Table 17 *) + kindEventMap (* Table 18 *) + kindIllegal (* kindEventPtr *) (* Table 19 *) + kindEvent (* Table 20 *) + kindPropertyMap (* Table 21 *) + kindIllegal (* kindPropertyPtr *) (* Table 22 *) + kindProperty (* Table 23 *) + kindMethodSemantics (* Table 24 *) + kindMethodImpl (* Table 25 *) + kindModuleRef (* Table 26 *) + kindTypeSpec (* Table 27 *) + kindImplMap (* Table 28 *) + kindFieldRVA (* Table 29 *) + kindIllegal (* kindENCLog *) (* Table 30 *) + kindIllegal (* kindENCMap *) (* Table 31 *) + kindAssembly (* Table 32 *) + kindIllegal (* kindAssemblyProcessor *) (* Table 33 *) + kindIllegal (* kindAssemblyOS *) (* Table 34 *) + kindAssemblyRef (* Table 35 *) + kindIllegal (* kindAssemblyRefProcessor *) (* Table 36 *) + kindIllegal (* kindAssemblyRefOS *) (* Table 37 *) + kindFileRef (* Table 38 *) + kindExportedType (* Table 39 *) + kindManifestResource (* Table 40 *) + kindNested (* Table 41 *) + kindGenericParam_v2_0 (* Table 42 *) + kindMethodSpec (* Table 43 *) + kindGenericParamConstraint (* Table 44 *) + kindIllegal (* Table 45 *) + kindIllegal (* Table 46 *) + kindIllegal (* Table 47 *) + kindIllegal (* Table 48 *) + kindIllegal (* Table 49 *) + kindIllegal (* Table 50 *) + kindIllegal (* Table 51 *) + kindIllegal (* Table 52 *) + kindIllegal (* Table 53 *) + kindIllegal (* Table 54 *) + kindIllegal (* Table 55 *) + kindIllegal (* Table 56 *) + kindIllegal (* Table 57 *) + kindIllegal (* Table 58 *) + kindIllegal (* Table 59 *) + kindIllegal (* Table 60 *) + kindIllegal (* Table 61 *) + kindIllegal (* Table 62 *) + kindIllegal (* Table 63 *) |] let heapSizes = seekReadByteAsInt32 is (tablesStreamPhysLoc + 6) @@ -3596,8 +3583,8 @@ let rec genOpenBinaryReader infile is opts = let prevNumRowIdx = ref (tablesStreamPhysLoc + 24) for i = 0 to 63 do if (valid &&& (int64 1 <<< i)) <> int64 0 then - present := i :: !present; - numRows.[i] <- (seekReadInt32 is !prevNumRowIdx); + present := i :: !present + numRows.[i] <- (seekReadInt32 is !prevNumRowIdx) prevNumRowIdx := !prevNumRowIdx + 4 List.rev !present, numRows, !prevNumRowIdx @@ -3607,9 +3594,9 @@ let rec genOpenBinaryReader infile is opts = let guidsBigness = (heapSizes &&& 2) <> 0 let blobsBigness = (heapSizes &&& 4) <> 0 - if logging then dprintn (infile + ": numTables = "+string numTables); - if logging && stringsBigness then dprintn (infile + ": strings are big"); - if logging && blobsBigness then dprintn (infile + ": blobs are big"); + if logging then dprintn (infile + ": numTables = "+string numTables) + if logging && stringsBigness then dprintn (infile + ": strings are big") + if logging && blobsBigness then dprintn (infile + ": blobs are big") let tableBigness = Array.map (fun n -> n >= 0x10000) tableRowCount @@ -3729,9 +3716,9 @@ let rec genOpenBinaryReader infile is opts = let res = Array.create 64 0x0 let prevTablePhysLoc = ref startOfTables for i = 0 to 63 do - res.[i] <- !prevTablePhysLoc; - prevTablePhysLoc := !prevTablePhysLoc + (tableRowCount.[i] * tableRowSizes.[i]); - if logging then dprintf "tablePhysLocations.[%d] = %d, offset from startOfTables = 0x%08x\n" i res.[i] (res.[i] - startOfTables); + res.[i] <- !prevTablePhysLoc + prevTablePhysLoc := !prevTablePhysLoc + (tableRowCount.[i] * tableRowSizes.[i]) + if logging then dprintf "tablePhysLocations.[%d] = %d, offset from startOfTables = 0x%08x\n" i res.[i] (res.[i] - startOfTables) res let inbase = Filename.fileNameOfPath infile + ": " @@ -3771,7 +3758,7 @@ let rec genOpenBinaryReader infile is opts = let count = ref 0 #if DEBUG #if STATISTICS - addReport (fun oc -> if !count <> 0 then oc.WriteLine (inbase+string !count + " "+_nm+" rows read")); + addReport (fun oc -> if !count <> 0 then oc.WriteLine (inbase+string !count + " "+_nm+" rows read")) #endif #else _nm |> ignore @@ -3820,11 +3807,9 @@ let rec genOpenBinaryReader infile is opts = let pdb = None #else let pdb = -#if ENABLE_MONO_SUPPORT if runningOnMono then None else -#endif getPdbReader opts infile #endif @@ -3834,110 +3819,110 @@ let rec genOpenBinaryReader infile is opts = // Build the reader context // Use an initialization hole let ctxtH = ref None - let ctxt = { ilg=opts.ilGlobals; - dataEndPoints = dataEndPoints ctxtH; - pdb=pdb; - sorted=sorted; - getNumRows=getNumRows; - textSegmentPhysicalLoc=textSegmentPhysicalLoc; - textSegmentPhysicalSize=textSegmentPhysicalSize; - dataSegmentPhysicalLoc=dataSegmentPhysicalLoc; - dataSegmentPhysicalSize=dataSegmentPhysicalSize; - anyV2P=anyV2P; - metadataAddr=metadataAddr; - sectionHeaders=sectionHeaders; - nativeResourcesAddr=nativeResourcesAddr; - nativeResourcesSize=nativeResourcesSize; - resourcesAddr=resourcesAddr; - strongnameAddr=strongnameAddr; - vtableFixupsAddr=vtableFixupsAddr; - is=is; - infile=infile; - userStringsStreamPhysicalLoc = userStringsStreamPhysicalLoc; - stringsStreamPhysicalLoc = stringsStreamPhysicalLoc; - blobsStreamPhysicalLoc = blobsStreamPhysicalLoc; - blobsStreamSize = blobsStreamSize; - memoizeString = Tables.memoize id; - readUserStringHeap = cacheUserStringHeap (readUserStringHeapUncached ctxtH); - readStringHeap = cacheStringHeap (readStringHeapUncached ctxtH); - readBlobHeap = cacheBlobHeap (readBlobHeapUncached ctxtH); - seekReadNestedRow = cacheNestedRow (seekReadNestedRowUncached ctxtH); - seekReadConstantRow = cacheConstantRow (seekReadConstantRowUncached ctxtH); - seekReadMethodSemanticsRow = cacheMethodSemanticsRow (seekReadMethodSemanticsRowUncached ctxtH); - seekReadTypeDefRow = cacheTypeDefRow (seekReadTypeDefRowUncached ctxtH); - seekReadInterfaceImplRow = cacheInterfaceImplRow (seekReadInterfaceImplRowUncached ctxtH); - seekReadFieldMarshalRow = cacheFieldMarshalRow (seekReadFieldMarshalRowUncached ctxtH); - seekReadPropertyMapRow = cachePropertyMapRow (seekReadPropertyMapRowUncached ctxtH); - seekReadAssemblyRef = cacheAssemblyRef (seekReadAssemblyRefUncached ctxtH); - seekReadMethodSpecAsMethodData = cacheMethodSpecAsMethodData (seekReadMethodSpecAsMethodDataUncached ctxtH); - seekReadMemberRefAsMethodData = cacheMemberRefAsMemberData (seekReadMemberRefAsMethodDataUncached ctxtH); - seekReadMemberRefAsFieldSpec = seekReadMemberRefAsFieldSpecUncached ctxtH; - seekReadCustomAttr = cacheCustomAttr (seekReadCustomAttrUncached ctxtH); - seekReadSecurityDecl = seekReadSecurityDeclUncached ctxtH; - seekReadTypeRef = cacheTypeRef (seekReadTypeRefUncached ctxtH); - readBlobHeapAsPropertySig = cacheBlobHeapAsPropertySig (readBlobHeapAsPropertySigUncached ctxtH); - readBlobHeapAsFieldSig = cacheBlobHeapAsFieldSig (readBlobHeapAsFieldSigUncached ctxtH); - readBlobHeapAsMethodSig = cacheBlobHeapAsMethodSig (readBlobHeapAsMethodSigUncached ctxtH); - readBlobHeapAsLocalsSig = readBlobHeapAsLocalsSigUncached ctxtH; - seekReadTypeDefAsType = cacheTypeDefAsType (seekReadTypeDefAsTypeUncached ctxtH); - seekReadTypeRefAsType = cacheTypeRefAsType (seekReadTypeRefAsTypeUncached ctxtH); - seekReadMethodDefAsMethodData = cacheMethodDefAsMethodData (seekReadMethodDefAsMethodDataUncached ctxtH); - seekReadGenericParams = cacheGenericParams (seekReadGenericParamsUncached ctxtH); - seekReadFieldDefAsFieldSpec = cacheFieldDefAsFieldSpec (seekReadFieldDefAsFieldSpecUncached ctxtH); - guidsStreamPhysicalLoc = guidsStreamPhysicalLoc; - rowAddr=rowAddr; - entryPointToken=entryPointToken; - rsBigness=rsBigness; - tdorBigness=tdorBigness; - tomdBigness=tomdBigness; - hcBigness=hcBigness; - hcaBigness=hcaBigness; - hfmBigness=hfmBigness; - hdsBigness=hdsBigness; - mrpBigness=mrpBigness; - hsBigness=hsBigness; - mdorBigness=mdorBigness; - mfBigness=mfBigness; - iBigness=iBigness; - catBigness=catBigness; - stringsBigness=stringsBigness; - guidsBigness=guidsBigness; - blobsBigness=blobsBigness; - tableBigness=tableBigness; - countTypeRef = countTypeRef; - countTypeDef = countTypeDef; - countField = countField; - countMethod = countMethod; - countParam = countParam; - countInterfaceImpl = countInterfaceImpl; - countMemberRef = countMemberRef; - countConstant = countConstant; - countCustomAttribute = countCustomAttribute; - countFieldMarshal = countFieldMarshal; - countPermission = countPermission; - countClassLayout = countClassLayout; - countFieldLayout = countFieldLayout; - countStandAloneSig = countStandAloneSig; - countEventMap = countEventMap; - countEvent = countEvent; - countPropertyMap = countPropertyMap; - countProperty = countProperty; - countMethodSemantics = countMethodSemantics; - countMethodImpl = countMethodImpl; - countModuleRef = countModuleRef; - countTypeSpec = countTypeSpec; - countImplMap = countImplMap; - countFieldRVA = countFieldRVA; - countAssembly = countAssembly; - countAssemblyRef = countAssemblyRef; - countFile = countFile; - countExportedType = countExportedType; - countManifestResource = countManifestResource; - countNested = countNested; - countGenericParam = countGenericParam; - countGenericParamConstraint = countGenericParamConstraint; - countMethodSpec = countMethodSpec; } - ctxtH := Some ctxt; + let ctxt = { ilg=opts.ilGlobals + dataEndPoints = dataEndPoints ctxtH + pdb=pdb + sorted=sorted + getNumRows=getNumRows + textSegmentPhysicalLoc=textSegmentPhysicalLoc + textSegmentPhysicalSize=textSegmentPhysicalSize + dataSegmentPhysicalLoc=dataSegmentPhysicalLoc + dataSegmentPhysicalSize=dataSegmentPhysicalSize + anyV2P=anyV2P + metadataAddr=metadataAddr + sectionHeaders=sectionHeaders + nativeResourcesAddr=nativeResourcesAddr + nativeResourcesSize=nativeResourcesSize + resourcesAddr=resourcesAddr + strongnameAddr=strongnameAddr + vtableFixupsAddr=vtableFixupsAddr + is=is + infile=infile + userStringsStreamPhysicalLoc = userStringsStreamPhysicalLoc + stringsStreamPhysicalLoc = stringsStreamPhysicalLoc + blobsStreamPhysicalLoc = blobsStreamPhysicalLoc + blobsStreamSize = blobsStreamSize + memoizeString = Tables.memoize id + readUserStringHeap = cacheUserStringHeap (readUserStringHeapUncached ctxtH) + readStringHeap = cacheStringHeap (readStringHeapUncached ctxtH) + readBlobHeap = cacheBlobHeap (readBlobHeapUncached ctxtH) + seekReadNestedRow = cacheNestedRow (seekReadNestedRowUncached ctxtH) + seekReadConstantRow = cacheConstantRow (seekReadConstantRowUncached ctxtH) + seekReadMethodSemanticsRow = cacheMethodSemanticsRow (seekReadMethodSemanticsRowUncached ctxtH) + seekReadTypeDefRow = cacheTypeDefRow (seekReadTypeDefRowUncached ctxtH) + seekReadInterfaceImplRow = cacheInterfaceImplRow (seekReadInterfaceImplRowUncached ctxtH) + seekReadFieldMarshalRow = cacheFieldMarshalRow (seekReadFieldMarshalRowUncached ctxtH) + seekReadPropertyMapRow = cachePropertyMapRow (seekReadPropertyMapRowUncached ctxtH) + seekReadAssemblyRef = cacheAssemblyRef (seekReadAssemblyRefUncached ctxtH) + seekReadMethodSpecAsMethodData = cacheMethodSpecAsMethodData (seekReadMethodSpecAsMethodDataUncached ctxtH) + seekReadMemberRefAsMethodData = cacheMemberRefAsMemberData (seekReadMemberRefAsMethodDataUncached ctxtH) + seekReadMemberRefAsFieldSpec = seekReadMemberRefAsFieldSpecUncached ctxtH + seekReadCustomAttr = cacheCustomAttr (seekReadCustomAttrUncached ctxtH) + seekReadSecurityDecl = seekReadSecurityDeclUncached ctxtH + seekReadTypeRef = cacheTypeRef (seekReadTypeRefUncached ctxtH) + readBlobHeapAsPropertySig = cacheBlobHeapAsPropertySig (readBlobHeapAsPropertySigUncached ctxtH) + readBlobHeapAsFieldSig = cacheBlobHeapAsFieldSig (readBlobHeapAsFieldSigUncached ctxtH) + readBlobHeapAsMethodSig = cacheBlobHeapAsMethodSig (readBlobHeapAsMethodSigUncached ctxtH) + readBlobHeapAsLocalsSig = readBlobHeapAsLocalsSigUncached ctxtH + seekReadTypeDefAsType = cacheTypeDefAsType (seekReadTypeDefAsTypeUncached ctxtH) + seekReadTypeRefAsType = cacheTypeRefAsType (seekReadTypeRefAsTypeUncached ctxtH) + seekReadMethodDefAsMethodData = cacheMethodDefAsMethodData (seekReadMethodDefAsMethodDataUncached ctxtH) + seekReadGenericParams = cacheGenericParams (seekReadGenericParamsUncached ctxtH) + seekReadFieldDefAsFieldSpec = cacheFieldDefAsFieldSpec (seekReadFieldDefAsFieldSpecUncached ctxtH) + guidsStreamPhysicalLoc = guidsStreamPhysicalLoc + rowAddr=rowAddr + entryPointToken=entryPointToken + rsBigness=rsBigness + tdorBigness=tdorBigness + tomdBigness=tomdBigness + hcBigness=hcBigness + hcaBigness=hcaBigness + hfmBigness=hfmBigness + hdsBigness=hdsBigness + mrpBigness=mrpBigness + hsBigness=hsBigness + mdorBigness=mdorBigness + mfBigness=mfBigness + iBigness=iBigness + catBigness=catBigness + stringsBigness=stringsBigness + guidsBigness=guidsBigness + blobsBigness=blobsBigness + tableBigness=tableBigness + countTypeRef = countTypeRef + countTypeDef = countTypeDef + countField = countField + countMethod = countMethod + countParam = countParam + countInterfaceImpl = countInterfaceImpl + countMemberRef = countMemberRef + countConstant = countConstant + countCustomAttribute = countCustomAttribute + countFieldMarshal = countFieldMarshal + countPermission = countPermission + countClassLayout = countClassLayout + countFieldLayout = countFieldLayout + countStandAloneSig = countStandAloneSig + countEventMap = countEventMap + countEvent = countEvent + countPropertyMap = countPropertyMap + countProperty = countProperty + countMethodSemantics = countMethodSemantics + countMethodImpl = countMethodImpl + countModuleRef = countModuleRef + countTypeSpec = countTypeSpec + countImplMap = countImplMap + countFieldRVA = countFieldRVA + countAssembly = countAssembly + countAssemblyRef = countAssemblyRef + countFile = countFile + countExportedType = countExportedType + countManifestResource = countManifestResource + countNested = countNested + countGenericParam = countGenericParam + countGenericParamConstraint = countGenericParamConstraint + countMethodSpec = countMethodSpec } + ctxtH := Some ctxt let ilModule = seekReadModule ctxt (subsys, (subsysMajor, subsysMinor), useHighEnthropyVA, ilOnly,only32,is32bitpreferred,only64,platform,isDll, alignVirt,alignPhys,imageBaseReal,System.Text.Encoding.UTF8.GetString (ilMetadataVersion, 0, ilMetadataVersion.Length)) 1 let ilAssemblyRefs = lazy [ for i in 1 .. getNumRows TableNames.AssemblyRef do yield seekReadAssemblyRef ctxt i ] @@ -3945,8 +3930,8 @@ let rec genOpenBinaryReader infile is opts = ilModule,ilAssemblyRefs,pdb let mkDefault ilg = - { optimizeForMemory=false; - pdbPath= None; + { optimizeForMemory=false + pdbPath= None ilGlobals = ilg } let ClosePdbReader pdb = @@ -3964,16 +3949,16 @@ let OpenILModuleReader infile opts = try let mmap = MemoryMappedFile.Create infile let modul,ilAssemblyRefs,pdb = genOpenBinaryReader infile mmap opts - { modul = modul; - ilAssemblyRefs=ilAssemblyRefs; + { modul = modul + ilAssemblyRefs=ilAssemblyRefs dispose = (fun () -> - mmap.Close(); + mmap.Close() ClosePdbReader pdb) } with _ -> let mc = ByteFile(infile |> FileSystem.ReadAllBytesShim) let modul,ilAssemblyRefs,pdb = genOpenBinaryReader infile mc opts - { modul = modul; - ilAssemblyRefs = ilAssemblyRefs; + { modul = modul + ilAssemblyRefs = ilAssemblyRefs dispose = (fun () -> ClosePdbReader pdb) } @@ -3999,7 +3984,7 @@ let OpenILModuleReaderAfterReadingAllBytes infile opts = let mc = ByteFile(infile |> FileSystem.ReadAllBytesShim) let modul,ilAssemblyRefs,pdb = genOpenBinaryReader infile mc opts let ilModuleReader = - { modul = modul; + { modul = modul ilAssemblyRefs = ilAssemblyRefs dispose = (fun () -> ClosePdbReader pdb) } if isNone pdb && succeeded then @@ -4011,7 +3996,7 @@ let OpenILModuleReaderFromBytes fileNameForDebugOutput bytes opts = let mc = ByteFile(bytes) let modul,ilAssemblyRefs,pdb = genOpenBinaryReader fileNameForDebugOutput mc opts let ilModuleReader = - { modul = modul; + { modul = modul ilAssemblyRefs = ilAssemblyRefs dispose = (fun () -> ClosePdbReader pdb) } ilModuleReader diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index 667051456cb..993b78959b7 100644 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -849,6 +849,9 @@ and GetTypeAsTypeDefOrRef cenv env (ty:ILType) = and GetTypeAsBytes cenv env ty = emitBytesViaBuffer (fun bb -> EmitType cenv env bb ty) +and GetTypeOfLocalAsBytes cenv env (l: ILLocal) = + emitBytesViaBuffer (fun bb -> EmitLocalInfo cenv env bb l) + and GetTypeAsBlobIdx cenv env (ty:ILType) = GetBytesAsBlobIdx cenv (GetTypeAsBytes cenv env ty) @@ -912,6 +915,11 @@ and EmitType cenv env bb ty = EmitType cenv env bb ty | _ -> failwith "EmitType" +and EmitLocalInfo cenv env (bb:ByteBuffer) (l:ILLocal) = + if l.IsPinned then + bb.EmitByte et_PINNED + EmitType cenv env bb l.Type + and EmitCallsig cenv env bb (callconv,args:ILTypes,ret,varargs:ILVarArgs,genarity) = bb.EmitByte (callconvToByte genarity callconv) if genarity > 0 then bb.EmitZ32 genarity @@ -1253,7 +1261,7 @@ let FindMethodDefIdx cenv mdkey = let (TdKey (tenc2,tname2)) = typeNameOfIdx mdkey2.TypeIdx dprintn ("A method in '"+(String.concat "." (tenc2@[tname2]))+"' had the right name but the wrong signature:") dprintn ("generic arity: "+string mdkey2.GenericArity) - dprintn (sprintf "mdkey2: %A" mdkey2)) + dprintn (sprintf "mdkey2: %+A" mdkey2)) raise MethodDefNotFound @@ -1494,7 +1502,7 @@ let GetCallsigAsStandAloneSigIdx cenv env info = let EmitLocalSig cenv env (bb: ByteBuffer) (locals: ILLocals) = bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG bb.EmitZ32 locals.Length - locals |> ILList.iter (fun l -> EmitType cenv env bb l.Type) + locals |> ILList.iter (EmitLocalInfo cenv env bb) let GetLocalSigAsBlobHeapIdx cenv env locals = GetBytesAsBlobIdx cenv (emitBytesViaBuffer (fun bb -> EmitLocalSig cenv env bb locals)) @@ -2237,7 +2245,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = // Write a fake entry for the local signature headed by e_IMAGE_CEE_CS_CALLCONV_FIELD. This is referenced by the PDB file ignore (FindOrAddSharedRow cenv TableNames.StandAloneSig (SharedRow [| Blob (GetFieldDefTypeAsBlobIdx cenv env l.Type) |])) // Now write the type - GetTypeAsBytes cenv env l.Type) + GetTypeOfLocalAsBytes cenv env l) else [| |] diff --git a/src/absil/ilwritepdb.fs b/src/absil/ilwritepdb.fs index cf397a0041c..c0cb29b7766 100644 --- a/src/absil/ilwritepdb.fs +++ b/src/absil/ilwritepdb.fs @@ -9,7 +9,6 @@ open System.IO open System.Reflection open System.Reflection.Metadata open System.Reflection.Metadata.Ecma335 -open System.Reflection.Metadata.Ecma335.Blobs open System.Reflection.PortableExecutable open Internal.Utilities open Microsoft.FSharp.Compiler.AbstractIL.IL @@ -222,10 +221,10 @@ let writePortablePdbInfo (fixupSPs:bool) showTimes fpdb (info:PdbData) = writer.WriteByte(byte(separator)) for part in name.Split( [| separator |] ) do - let partIndex = MetadataTokens.GetHeapOffset(BlobHandle.op_Implicit(metadata.GetBlobUtf8(part))) + let partIndex = MetadataTokens.GetHeapOffset(BlobHandle.op_Implicit(metadata.GetOrAddBlobUTF8(part))) writer.WriteCompressedInteger(int(partIndex)) - metadata.GetBlob(writer); + metadata.GetOrAddBlob(writer); let corSymLanguageTypeFSharp = System.Guid(0xAB4F38C9u, 0xB6E6us, 0x43baus, 0xBEuy, 0x3Buy, 0x58uy, 0x08uy, 0x0Buy, 0x2Cuy, 0xCCuy, 0xE3uy) let documentIndex = @@ -236,14 +235,14 @@ let writePortablePdbInfo (fixupSPs:bool) showTimes fpdb (info:PdbData) = match checkSum doc.File with | Some (hashAlg, checkSum) -> serializeDocumentName doc.File, - metadata.GetGuid(hashAlg), - metadata.GetBlob(checkSum.ToImmutableArray()), - metadata.GetGuid(corSymLanguageTypeFSharp) + metadata.GetOrAddGuid(hashAlg), + metadata.GetOrAddBlob(checkSum.ToImmutableArray()), + metadata.GetOrAddGuid(corSymLanguageTypeFSharp) | None -> serializeDocumentName doc.File, - metadata.GetGuid(System.Guid.Empty), - metadata.GetBlob(ImmutableArray.Empty), - metadata.GetGuid(corSymLanguageTypeFSharp) + metadata.GetOrAddGuid(System.Guid.Empty), + metadata.GetOrAddBlob(ImmutableArray.Empty), + metadata.GetOrAddGuid(corSymLanguageTypeFSharp) |> metadata.AddDocument index.Add(doc.File, handle) index @@ -332,7 +331,7 @@ let writePortablePdbInfo (fixupSPs:bool) showTimes fpdb (info:PdbData) = previousNonHiddenStartLine <- sps.[i].Line previousNonHiddenStartColumn <- sps.[i].Column - getDocumentHandle singleDocumentIndex, metadata.GetBlob(builder) + getDocumentHandle singleDocumentIndex, metadata.GetOrAddBlob(builder) // Write the scopes let mutable lastLocalVariableHandle = Unchecked.defaultof @@ -347,7 +346,7 @@ let writePortablePdbInfo (fixupSPs:bool) showTimes fpdb (info:PdbData) = scope.StartOffset, scope.EndOffset - scope.StartOffset) |>ignore for localVariable in scope.Locals do - lastLocalVariableHandle <- metadata.AddLocalVariable(LocalVariableAttributes.None, localVariable.Index, metadata.GetString(localVariable.Name)) + lastLocalVariableHandle <- metadata.AddLocalVariable(LocalVariableAttributes.None, localVariable.Index, metadata.GetOrAddString(localVariable.Name)) scope.Children |> Array.iter (writePdbScope false) writePdbScope true minfo.RootScope @@ -358,10 +357,9 @@ let writePortablePdbInfo (fixupSPs:bool) showTimes fpdb (info:PdbData) = | None -> MetadataTokens.MethodDefinitionHandle(0) | Some x -> MetadataTokens.MethodDefinitionHandle(x) - let pdbContentId = ContentId(info.ModuleID, BitConverter.GetBytes(info.Timestamp)) - let serializer = StandaloneDebugMetadataSerializer(metadata, externalRowCounts, entryPoint, false) + let serializer = PortablePdbBuilder(metadata, externalRowCounts, entryPoint, null ) let blobBuilder = new BlobBuilder() - serializer.SerializeMetadata(blobBuilder, (fun builder -> pdbContentId)) |> ignore + serializer.Serialize(blobBuilder) |> ignore reportTime showTimes "PDB: Created" use portablePdbStream = new FileStream(fpdb, FileMode.Create, FileAccess.ReadWrite) diff --git a/src/absil/ilx.fs b/src/absil/ilx.fs index efc5056aac6..d183fe0796b 100644 --- a/src/absil/ilx.fs +++ b/src/absil/ilx.fs @@ -45,16 +45,17 @@ type IlxUnionHasHelpers = | SpecialFSharpOptionHelpers type IlxUnionRef = - | IlxUnionRef of ILTypeRef * IlxUnionAlternative[] * bool * (* hasHelpers: *) IlxUnionHasHelpers + | IlxUnionRef of boxity: ILBoxity * ILTypeRef * IlxUnionAlternative[] * bool * (* hasHelpers: *) IlxUnionHasHelpers type IlxUnionSpec = | IlxUnionSpec of IlxUnionRef * ILGenericArgs - member x.EnclosingType = let (IlxUnionSpec(IlxUnionRef(tref,_,_,_),inst)) = x in mkILBoxedTyRaw tref inst - member x.TypeRef = let (IlxUnionSpec(IlxUnionRef(tref,_,_,_),_)) = x in tref + member x.EnclosingType = let (IlxUnionSpec(IlxUnionRef(bx,tref,_,_,_),inst)) = x in mkILNamedTy bx tref inst + member x.Boxity = let (IlxUnionSpec(IlxUnionRef(bx,_,_,_,_),_)) = x in bx + member x.TypeRef = let (IlxUnionSpec(IlxUnionRef(_,tref,_,_,_),_)) = x in tref member x.GenericArgs = let (IlxUnionSpec(_,inst)) = x in inst - member x.AlternativesArray = let (IlxUnionSpec(IlxUnionRef(_,alts,_,_),_)) = x in alts - member x.IsNullPermitted = let (IlxUnionSpec(IlxUnionRef(_,_,np,_),_)) = x in np - member x.HasHelpers = let (IlxUnionSpec(IlxUnionRef(_,_,_,b),_)) = x in b + member x.AlternativesArray = let (IlxUnionSpec(IlxUnionRef(_,_,alts,_,_),_)) = x in alts + member x.IsNullPermitted = let (IlxUnionSpec(IlxUnionRef(_,_,_,np,_),_)) = x in np + member x.HasHelpers = let (IlxUnionSpec(IlxUnionRef(_,_,_,_,b),_)) = x in b member x.Alternatives = Array.toList x.AlternativesArray member x.Alternative idx = x.AlternativesArray.[idx] member x.FieldDef idx fidx = x.Alternative(idx).FieldDef(fidx) diff --git a/src/absil/ilx.fsi b/src/absil/ilx.fsi index db96d9cdb4c..b7413fbf698 100644 --- a/src/absil/ilx.fsi +++ b/src/absil/ilx.fsi @@ -40,7 +40,7 @@ type IlxUnionHasHelpers = | SpecialFSharpOptionHelpers type IlxUnionRef = - | IlxUnionRef of ILTypeRef * IlxUnionAlternative[] * bool (* cudNullPermitted *) * IlxUnionHasHelpers (* cudHasHelpers *) + | IlxUnionRef of boxity: ILBoxity * ILTypeRef * IlxUnionAlternative[] * bool (* cudNullPermitted *) * IlxUnionHasHelpers (* cudHasHelpers *) type IlxUnionSpec = | IlxUnionSpec of IlxUnionRef * ILGenericArgs @@ -48,6 +48,7 @@ type IlxUnionSpec = member GenericArgs : ILGenericArgs member Alternatives : IlxUnionAlternative list member AlternativesArray : IlxUnionAlternative[] + member Boxity : ILBoxity member TypeRef : ILTypeRef member IsNullPermitted : bool member HasHelpers : IlxUnionHasHelpers diff --git a/src/fsharp/AccessibilityLogic.fs b/src/fsharp/AccessibilityLogic.fs index 38354e674e2..525995cca1f 100644 --- a/src/fsharp/AccessibilityLogic.fs +++ b/src/fsharp/AccessibilityLogic.fs @@ -70,11 +70,14 @@ let private IsILMemberAccessible g amap m (tcrefOfViewedItem : TyconRef) ad acce match ad with | AccessibleFromEverywhere -> access = ILMemberAccess.Public + | AccessibleFromSomeFSharpCode -> (access = ILMemberAccess.Public || access = ILMemberAccess.Family || access = ILMemberAccess.FamilyOrAssembly) + | AccessibleFrom (cpaths,tcrefViewedFromOption) -> + let accessibleByFamily = ((access = ILMemberAccess.Family || access = ILMemberAccess.FamilyOrAssembly) && @@ -82,9 +85,13 @@ let private IsILMemberAccessible g amap m (tcrefOfViewedItem : TyconRef) ad acce | None -> false | Some tcrefViewedFrom -> ExistsHeadTypeInEntireHierarchy g amap m (generalizedTyconRef tcrefViewedFrom) tcrefOfViewedItem) + let accessibleByInternalsVisibleTo = - (access = ILMemberAccess.Assembly && canAccessFromOneOf cpaths tcrefOfViewedItem.CompilationPath) + (access = ILMemberAccess.Assembly || access = ILMemberAccess.FamilyOrAssembly) && + canAccessFromOneOf cpaths tcrefOfViewedItem.CompilationPath + (access = ILMemberAccess.Public) || accessibleByFamily || accessibleByInternalsVisibleTo + | AccessibleFromSomewhere -> true diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index 3b4031007c1..62345423668 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -110,28 +110,42 @@ let mkCombineHashGenerators g m exprs accv acce = // Build comparison functions for union, record and exception types. //------------------------------------------------------------------------- +let mkThatAddrLocal g m ty = mkCompGenLocal m "obj" (mkThisTy g ty) +let mkThatAddrLocalIfNeeded g m tcve ty = + if isStructTy g ty then + let thataddrv, thataddre = mkCompGenLocal m "obj" (mkThisTy g ty) + Some thataddrv, thataddre + else None,tcve + let mkThisVarThatVar g m ty = let thisv,thise = mkThisVar g m ty - let thatv,thate = mkCompGenLocal m "obj" (mkThisTy g ty) - thisv,thatv,thise,thate + let thataddrv,thataddre = mkThatAddrLocal g m ty + thisv,thataddrv,thise,thataddre -let mkThatVarBind g m ty thatv expr = +let mkThatVarBind g m ty thataddrv expr = if isStructTy g ty then let thatv2,_ = mkMutableCompGenLocal m "obj" ty - thatv2,mkCompGenLet m thatv (mkValAddr m (mkLocalValRef thatv2)) expr - else thatv,expr + thatv2,mkCompGenLet m thataddrv (mkValAddr m (mkLocalValRef thatv2)) expr + else thataddrv,expr -let mkThatAddrLocal g m ty = - if isStructTy g ty then - mkMutableCompGenLocal m "objCast" (mkByrefTy g ty) - else - mkCompGenLocal m "objCast" ty - let mkBindThatAddr g m ty thataddrv thatv thate expr = if isStructTy g ty then - mkCompGenLet m thataddrv (mkValAddr m (mkLocalValRef thatv)) expr + // let thataddrv = &thatv + mkCompGenLet m thataddrv (mkValAddr m (mkLocalValRef thatv)) expr else - mkCompGenLet m thataddrv thate expr + // let thataddrv = that + mkCompGenLet m thataddrv thate expr + +let mkBindThatAddrIfNeeded m thataddrvOpt thatv expr = + match thataddrvOpt with + | None -> expr + | Some thataddrv -> + // let thataddrv = &thatv + mkCompGenLet m thataddrv (mkValAddr m (mkLocalValRef thatv)) expr + +let mkDerefThis g m (thisv: Val) thise = + if isByrefTy g thisv.Type then mkAddrGet m (mkLocalValRef thisv) + else thise let mkCompareTestConjuncts g m exprs = match exprs with @@ -186,7 +200,7 @@ let mkRecdCompare g tcref (tycon:Tycon) = let m = tycon.Range let fields = tycon.AllInstanceFieldsAsList let tinst,ty = mkMinimalTy g tcref - let thisv,thatv,thise,thate = mkThisVarThatVar g m ty + let thisv,thataddrv,thise,thataddre = mkThisVarThatVar g m ty let compe = mkILCallGetComparer g m let mkTest (fspec:RecdField) = let fty = fspec.FormalType @@ -195,12 +209,12 @@ let mkRecdCompare g tcref (tycon:Tycon) = mkCallGenericComparisonWithComparerOuter g m fty compe (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m)) - (mkRecdFieldGetViaExprAddr(thate, fref, tinst, m)) + (mkRecdFieldGetViaExprAddr(thataddre, fref, tinst, m)) let expr = mkCompareTestConjuncts g m (List.map mkTest fields) - let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thate expr + let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thataddre expr - let thatv,expr = mkThatVarBind g m ty thatv expr + let thatv,expr = mkThatVarBind g m ty thataddrv expr thisv,thatv, expr @@ -235,19 +249,19 @@ let mkRecdEquality g tcref (tycon:Tycon) = let m = tycon.Range let fields = tycon.AllInstanceFieldsAsList let tinst,ty = mkMinimalTy g tcref - let thisv,thatv,thise,thate = mkThisVarThatVar g m ty + let thisv,thataddrv,thise,thataddre = mkThisVarThatVar g m ty let mkTest (fspec:RecdField) = let fty = fspec.FormalType let fref = tcref.MakeNestedRecdFieldRef fspec let m = fref.Range mkCallGenericEqualityEROuter g m fty (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m)) - (mkRecdFieldGetViaExprAddr(thate, fref, tinst, m)) + (mkRecdFieldGetViaExprAddr(thataddre, fref, tinst, m)) let expr = mkEqualsTestConjuncts g m (List.map mkTest fields) - let expr = if tycon.IsStructOrEnumTycon then expr else mkBindThatNullEquals g m thise thate expr + let expr = if tycon.IsStructOrEnumTycon then expr else mkBindThatNullEquals g m thise thataddre expr - let thatv,expr = mkThatVarBind g m ty thatv expr + let thatv,expr = mkThatVarBind g m ty thataddrv expr thisv,thatv,expr /// Build the equality implementation for a record type when parameterized by a comparer @@ -288,12 +302,11 @@ let mkExnEquality g exnref (exnc:Tycon) = let expr = mkEqualsTestConjuncts g m (List.mapi mkTest (exnc.AllInstanceFieldsAsList)) let expr = let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) - let dtree = - TDSwitch(thate, - [ mkCase(Test.IsInst(g.exn_ty,mkAppTy exnref []), - mbuilder.AddResultTarget(expr,SuppressSequencePointAtTarget)) ], - Some(mbuilder.AddResultTarget(mkFalse g m,SuppressSequencePointAtTarget)), - m) + let cases = + [ mkCase(Test.IsInst(g.exn_ty,mkAppTy exnref []), + mbuilder.AddResultTarget(expr,SuppressSequencePointAtTarget)) ] + let dflt = Some(mbuilder.AddResultTarget(mkFalse g m,SuppressSequencePointAtTarget)) + let dtree = TDSwitch(thate,cases,dflt,m) mbuilder.Close(dtree,m,g.bool_ty) let expr = mkBindThatNullEquals g m thise thate expr @@ -313,12 +326,11 @@ let mkExnEqualityWithComparer g exnref (exnc:Tycon) (_thisv,thise) thatobje (tha let expr = mkEqualsTestConjuncts g m (List.mapi mkTest (exnc.AllInstanceFieldsAsList)) let expr = let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) - let dtree = - TDSwitch(thataddre, - [ mkCase(Test.IsInst(g.exn_ty,mkAppTy exnref []), - mbuilder.AddResultTarget(expr,SuppressSequencePointAtTarget)) ], - Some(mbuilder.AddResultTarget(mkFalse g m,SuppressSequencePointAtTarget)), - m) + let cases = + [ mkCase(Test.IsInst(g.exn_ty,mkAppTy exnref []), + mbuilder.AddResultTarget(expr,SuppressSequencePointAtTarget)) ] + let dflt = mbuilder.AddResultTarget(mkFalse g m,SuppressSequencePointAtTarget) + let dtree = TDSwitch(thate,cases,Some dflt,m) mbuilder.Close(dtree,m,g.bool_ty) let expr = mkBindThatAddr g m g.exn_ty thataddrv thatv thate expr let expr = mkIsInstConditional g m g.exn_ty thatobje thatv expr (mkFalse g m) @@ -330,8 +342,7 @@ let mkUnionCompare g tcref (tycon:Tycon) = let m = tycon.Range let ucases = tycon.UnionCasesAsList let tinst,ty = mkMinimalTy g tcref - let thisv,thise = mkCompGenLocal m "this" ty - let thatv,thate = mkCompGenLocal m "obj" ty + let thisv,thataddrv,thise,thataddre = mkThisVarThatVar g m ty let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty let compe = mkILCallGetComparer g m @@ -341,30 +352,29 @@ let mkUnionCompare g tcref (tycon:Tycon) = let mkCase ucase = let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range - let thisucv,thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst) - let thatucv,thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst) - let mkTest j (argty:RecdField) = - mkCallGenericComparisonWithComparerOuter g m argty.FormalType - compe - (mkUnionCaseFieldGetProven(thisucve, cref, tinst, j, m)) - (mkUnionCaseFieldGetProven(thatucve, cref, tinst, j, m)) let rfields = ucase.RecdFields if isNil rfields then None else - Some (mkCase(Test.UnionCase(cref,tinst), - mbuilder.AddResultTarget - (mkCompGenLet m thisucv (mkUnionCaseProof(thise,cref,tinst,m)) - (mkCompGenLet m thatucv (mkUnionCaseProof(thate,cref,tinst,m)) - (mkCompareTestConjuncts g m (List.mapi mkTest rfields))), - SuppressSequencePointAtTarget))) + let mkTest thise thataddre j (argty:RecdField) = + mkCallGenericComparisonWithComparerOuter g m argty.FormalType + compe + (mkUnionCaseFieldGetProvenViaExprAddr(thise, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr(thataddre, cref, tinst, j, m)) + let test = + if cref.Tycon.IsStructOrEnumTycon then + mkCompareTestConjuncts g m (List.mapi (mkTest thise thataddre) rfields) + else + let thisucv,thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst) + let thatucv,thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst) + mkCompGenLet m thisucv (mkUnionCaseProof (thise,cref,tinst,m)) + (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre,cref,tinst,m)) + (mkCompareTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields))) + Some (mkCase(Test.UnionCase(cref,tinst),mbuilder.AddResultTarget(test,SuppressSequencePointAtTarget))) let nullary,nonNullary = List.partition isNone (List.map mkCase ucases) if isNil nonNullary then mkZero g m else - let dtree = - TDSwitch(thise, - (nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionCompare")), - (if isNil nullary then None - else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget))), - m) + let cases = nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionCompare") + let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget)) + let dtree = TDSwitch(thise, cases, dflt,m) mbuilder.Close(dtree,m,g.int_ty) let expr = @@ -375,53 +385,56 @@ let mkUnionCompare g tcref (tycon:Tycon) = expr (mkAsmExpr ([ IL.AI_sub ],[], [thistage; thattage],[g.int_ty],m))in mkCompGenLet m thistagv - (mkUnionCaseTagGet (thise,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thise,tcref,tinst,m)) (mkCompGenLet m thattagv - (mkUnionCaseTagGet (thate,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thataddre,tcref,tinst,m)) tagsEqTested) - let expr = mkBindNullComparison g m thise thate expr - thisv,thatv, expr + let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thataddre expr + thisv,thataddrv, expr /// Build the comparison implementation for a union type when parameterized by a comparer -let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (thatv,thate) compe = +let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_thatobjv,thatcaste) compe = let m = tycon.Range let ucases = tycon.UnionCasesAsList let tinst,ty = mkMinimalTy g tcref + let tcv,tce = mkCompGenLocal m "objTemp" ty // let tcv = (thatobj :?> ty) + let thataddrvOpt,thataddre = mkThatAddrLocalIfNeeded g m tce ty // let thataddrv = &tcv if struct, otherwise thataddre is just tce let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty - let thataddrv,thataddre = mkThatAddrLocal g m ty let expr = let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) let mkCase ucase = let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range - let thisucv,thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst) - let thatucv,thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst) - let mkTest j (argty:RecdField) = - mkCallGenericComparisonWithComparerOuter g m argty.FormalType - compe - (mkUnionCaseFieldGetProven(thisucve, cref, tinst, j, m)) - (mkUnionCaseFieldGetProven(thatucve, cref, tinst, j, m)) let rfields = ucase.RecdFields if isNil rfields then None else - Some (mkCase(Test.UnionCase(cref,tinst), - mbuilder.AddResultTarget - (mkCompGenLet m thisucv (mkUnionCaseProof(thise,cref,tinst,m)) - (mkCompGenLet m thatucv (mkUnionCaseProof(thataddre,cref,tinst,m)) - (mkCompareTestConjuncts g m (List.mapi mkTest rfields))), - SuppressSequencePointAtTarget))) + + let mkTest thise thataddre j (argty:RecdField) = + mkCallGenericComparisonWithComparerOuter g m argty.FormalType + compe + (mkUnionCaseFieldGetProvenViaExprAddr(thise, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr(thataddre, cref, tinst, j, m)) + + let test = + if cref.Tycon.IsStructOrEnumTycon then + mkCompareTestConjuncts g m (List.mapi (mkTest thise thataddre) rfields) + else + let thisucv,thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst) + let thatucv,thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst) + mkCompGenLet m thisucv (mkUnionCaseProof (thise,cref,tinst,m)) + (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre,cref,tinst,m)) + (mkCompareTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields))) + + Some (mkCase(Test.UnionCase(cref,tinst),mbuilder.AddResultTarget(test,SuppressSequencePointAtTarget))) let nullary,nonNullary = List.partition isNone (List.map mkCase ucases) if isNil nonNullary then mkZero g m else - let dtree = - TDSwitch(thise, - (nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionCompare")), - (if isNil nullary then None - else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget))), - m) + let cases = nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionCompare") + let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget)) + let dtree = TDSwitch(thise, cases, dflt,m) mbuilder.Close(dtree,m,g.int_ty) let expr = @@ -432,13 +445,14 @@ let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (thatv,thate expr (mkAsmExpr ([ IL.AI_sub ],[], [thistage; thattage],[g.int_ty],m))in mkCompGenLet m thistagv - (mkUnionCaseTagGet (thise,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thise,tcref,tinst,m)) (mkCompGenLet m thattagv - (mkUnionCaseTagGet (thataddre,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thataddre,tcref,tinst,m)) tagsEqTested) - let expr = mkBindNullComparison g m thise thate expr - let expr = mkBindThatAddr g m ty thataddrv thatv thate expr + let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thatcaste expr + let expr = mkBindThatAddrIfNeeded m thataddrvOpt tcv expr + let expr = mkCompGenLet m tcv thatcaste expr expr @@ -447,8 +461,7 @@ let mkUnionEquality g tcref (tycon:Tycon) = let m = tycon.Range let ucases = tycon.UnionCasesAsList let tinst,ty = mkMinimalTy g tcref - let thisv,thise = mkCompGenLocal m "this" ty - let thatv,thate = mkCompGenLocal m "obj" ty + let thisv,thataddrv,thise,thataddre = mkThisVarThatVar g m ty let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty @@ -457,27 +470,31 @@ let mkUnionEquality g tcref (tycon:Tycon) = let mkCase ucase = let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range - let thisucv,thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst) - let thatucv,thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst) - let mkTest j (argty:RecdField) = - mkCallGenericEqualityEROuter g m argty.FormalType - (mkUnionCaseFieldGetProven(thisucve, cref, tinst, j, m)) - (mkUnionCaseFieldGetProven(thatucve, cref, tinst, j, m)) let rfields = ucase.RecdFields if isNil rfields then None else - Some (mkCase(Test.UnionCase(cref,tinst), - mbuilder.AddResultTarget - (mkCompGenLet m thisucv (mkUnionCaseProof(thise,cref,tinst,m)) - (mkCompGenLet m thatucv (mkUnionCaseProof(thate,cref,tinst,m)) - (mkEqualsTestConjuncts g m (List.mapi mkTest rfields))), - SuppressSequencePointAtTarget))) + + let mkTest thise thataddre j (argty:RecdField) = + mkCallGenericEqualityEROuter g m argty.FormalType + (mkUnionCaseFieldGetProvenViaExprAddr(thise, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr(thataddre, cref, tinst, j, m)) + + let test = + if cref.Tycon.IsStructOrEnumTycon then + mkEqualsTestConjuncts g m (List.mapi (mkTest thise thataddre) rfields) + else + let thisucv,thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst) + let thatucv,thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst) + mkCompGenLet m thisucv (mkUnionCaseProof (thise,cref,tinst,m)) + (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre,cref,tinst,m)) + (mkEqualsTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields))) + + Some (mkCase(Test.UnionCase(cref,tinst), mbuilder.AddResultTarget(test, SuppressSequencePointAtTarget))) let nullary,nonNullary = List.partition isNone (List.map mkCase ucases) if isNil nonNullary then mkTrue g m else - let dtree = - TDSwitch(thise,List.map (function (Some c) -> c | None -> failwith "mkUnionEquality") nonNullary, - (if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget))), - m) + let cases = List.map (function (Some c) -> c | None -> failwith "mkUnionEquality") nonNullary + let dflt = (if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget))) + let dtree = TDSwitch(thise, cases, dflt, m) mbuilder.Close(dtree,m,g.bool_ty) let expr = @@ -489,13 +506,14 @@ let mkUnionEquality g tcref (tycon:Tycon) = (mkFalse g m) mkCompGenLet m thistagv - (mkUnionCaseTagGet (thise,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thise,tcref,tinst,m)) (mkCompGenLet m thattagv - (mkUnionCaseTagGet (thate,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thataddre,tcref,tinst,m)) tagsEqTested) - let expr = mkBindThatNullEquals g m thise thate expr - thisv,thatv, expr + let thatv,expr = mkThatVarBind g m ty thataddrv expr + let expr = if tycon.IsStructOrEnumTycon then expr else mkBindThatNullEquals g m thise thataddre expr + thisv,thatv,expr /// Build the equality implementation for a union type when parameterized by a comparer @@ -512,28 +530,34 @@ let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (t let mkCase ucase = let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range - let thisucv,thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst) - let thatucv,thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst) - let mkTest j (argty:RecdField) = - mkCallGenericEqualityWithComparerOuter g m argty.FormalType - compe - (mkUnionCaseFieldGetProven(thisucve, cref, tinst, j, m)) - (mkUnionCaseFieldGetProven(thatucve, cref, tinst, j, m)) + let rfields = ucase.RecdFields if isNil rfields then None else - Some (mkCase(Test.UnionCase(cref,tinst), - mbuilder.AddResultTarget - (mkCompGenLet m thisucv (mkUnionCaseProof(thise,cref,tinst,m)) - (mkCompGenLet m thatucv (mkUnionCaseProof(thataddre,cref,tinst,m)) - (mkEqualsTestConjuncts g m (List.mapi mkTest rfields))), - SuppressSequencePointAtTarget))) + + let mkTest thise thataddre j (argty:RecdField) = + mkCallGenericEqualityWithComparerOuter g m argty.FormalType + compe + (mkUnionCaseFieldGetProvenViaExprAddr(thise, cref, tinst, j, m)) + (mkUnionCaseFieldGetProvenViaExprAddr(thataddre, cref, tinst, j, m)) + + let test = + if cref.Tycon.IsStructOrEnumTycon then + mkEqualsTestConjuncts g m (List.mapi (mkTest thise thataddre) rfields) + else + let thisucv,thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst) + let thatucv,thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst) + + mkCompGenLet m thisucv (mkUnionCaseProof (thise,cref,tinst,m)) + (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre,cref,tinst,m)) + (mkEqualsTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields))) + + Some (mkCase(Test.UnionCase(cref,tinst), mbuilder.AddResultTarget (test, SuppressSequencePointAtTarget))) let nullary,nonNullary = List.partition isNone (List.map mkCase ucases) if isNil nonNullary then mkTrue g m else - let dtree = - TDSwitch(thise,List.map (function (Some c) -> c | None -> failwith "mkUnionEquality") nonNullary, - (if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget))), - m) + let cases = List.map (function (Some c) -> c | None -> failwith "mkUnionEquality") nonNullary + let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget)) + let dtree = TDSwitch(thise, cases, dflt, m) mbuilder.Close(dtree,m,g.bool_ty) let expr = @@ -545,9 +569,9 @@ let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (t (mkFalse g m) mkCompGenLet m thistagv - (mkUnionCaseTagGet (thise,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thise,tcref,tinst,m)) (mkCompGenLet m thattagv - (mkUnionCaseTagGet (thataddre,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thataddre,tcref,tinst,m)) tagsEqTested) let expr = mkBindThatAddr g m ty thataddrv thatv thate expr let expr = mkIsInstConditional g m ty thatobje thatv expr (mkFalse g m) @@ -605,25 +629,32 @@ let mkUnionHashWithComparer g tcref (tycon:Tycon) compe = let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) let accv,acce = mkMutableCompGenLocal m "i" g.int_ty let mkCase i ucase1 = - let c1ref = tcref.MakeNestedUnionCaseRef ucase1 - let ucv,ucve = mkCompGenLocal m "unionCase" (mkProvenUnionCaseTy c1ref tinst) - let m = c1ref.Range - let mkHash j (rfield:RecdField) = - let fty = rfield.FormalType - let e = mkUnionCaseFieldGetProven(ucve, c1ref, tinst, j, m) - mkCallGenericHashWithComparerOuter g m fty compe e - mkCase(Test.UnionCase(c1ref,tinst), - mbuilder.AddResultTarget - (mkCompGenLet m ucv - (mkUnionCaseProof(thise,c1ref,tinst,m)) + let c1ref = tcref.MakeNestedUnionCaseRef ucase1 + let m = c1ref.Range + let mkHash thise j (rfield:RecdField) = + let fty = rfield.FormalType + let e = mkUnionCaseFieldGetProvenViaExprAddr(thise, c1ref, tinst, j, m) + mkCallGenericHashWithComparerOuter g m fty compe e + + let test = + if tycon.IsStructOrEnumTycon then + mkCompGenSequential m + (mkValSet m (mkLocalValRef accv) (mkInt g m i)) + (mkCombineHashGenerators g m (List.mapi (mkHash thise) ucase1.RecdFields) (mkLocalValRef accv) acce) + else + let ucv,ucve = mkCompGenLocal m "unionCase" (mkProvenUnionCaseTy c1ref tinst) + mkCompGenLet m ucv + (mkUnionCaseProof (thise,c1ref,tinst,m)) (mkCompGenSequential m - (mkValSet m (mkLocalValRef accv) (mkInt g m i)) - (mkCombineHashGenerators g m (List.mapi mkHash ucase1.RecdFields) (mkLocalValRef accv) acce)), - SuppressSequencePointAtTarget)) - let dtree = TDSwitch(thise,List.mapi mkCase ucases, None,m) + (mkValSet m (mkLocalValRef accv) (mkInt g m i)) + (mkCombineHashGenerators g m (List.mapi (mkHash ucve) ucase1.RecdFields) (mkLocalValRef accv) acce)) + + mkCase(Test.UnionCase(c1ref,tinst),mbuilder.AddResultTarget(test,SuppressSequencePointAtTarget)) + + let dtree = TDSwitch(thise, List.mapi mkCase ucases, None,m) let stmt = mbuilder.Close(dtree,m,g.int_ty) let expr = mkCompGenLet m accv (mkZero g m) stmt - let expr = mkBindNullHash g m thise expr + let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullHash g m thise expr thisv,expr @@ -819,24 +850,24 @@ let TyconIsCandidateForAugmentationWithHash g tycon = TyconIsCandidateForAugment //------------------------------------------------------------------------- let slotImplMethod (final,c,slotsig) : ValMemberInfo = - { ImplementedSlotSigs=[slotsig]; + { ImplementedSlotSigs=[slotsig] MemberFlags= - { IsInstance=true; - IsDispatchSlot=false; - IsFinal=final; - IsOverrideOrExplicitImpl=true; - MemberKind=MemberKind.Member}; - IsImplemented=false; + { IsInstance=true + IsDispatchSlot=false + IsFinal=final + IsOverrideOrExplicitImpl=true + MemberKind=MemberKind.Member} + IsImplemented=false ApparentParent=c} let nonVirtualMethod c : ValMemberInfo = - { ImplementedSlotSigs=[]; - MemberFlags={ IsInstance=true; - IsDispatchSlot=false; - IsFinal=false; - IsOverrideOrExplicitImpl=false; - MemberKind=MemberKind.Member}; - IsImplemented=false; + { ImplementedSlotSigs=[] + MemberFlags={ IsInstance=true + IsDispatchSlot=false + IsFinal=false + IsOverrideOrExplicitImpl=false + MemberKind=MemberKind.Member} + IsImplemented=false ApparentParent=c} let unitArg = ValReprInfo.unitArgData @@ -914,7 +945,7 @@ let MakeBindingsForCompareAugmentation g (tycon:Tycon) = let thisv,thatv,comparee = comparef g tcref tycon mkLambdas m tps [thisv;thatv] (comparee,g.int_ty) [ // This one must come first because it may be inlined into the second - mkCompGenBind vspec2 rhs2; + mkCompGenBind vspec2 rhs2 mkCompGenBind vspec1 rhs1; ] if tycon.IsUnionTycon then mkCompare mkUnionCompare elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then mkCompare mkRecdCompare @@ -985,8 +1016,8 @@ let MakeBindingsForEqualityWithComparerAugmentation g (tycon:Tycon) = mkLambdas m tps [thisv; unitv] (hashe,g.int_ty) - [(mkCompGenBind withcGetHashCodeVal.Deref withcGetHashCodeExpr) ; - (mkCompGenBind objGetHashCodeVal.Deref objGetHashCodeExpr) ; + [(mkCompGenBind withcGetHashCodeVal.Deref withcGetHashCodeExpr) + (mkCompGenBind objGetHashCodeVal.Deref objGetHashCodeExpr) (mkCompGenBind withcEqualsVal.Deref withcEqualsExpr)] if tycon.IsUnionTycon then mkStructuralEquatable mkUnionHashWithComparer mkUnionEqualityWithComparer elif (tycon.IsRecordTycon || tycon.IsStructOrEnumTycon) then mkStructuralEquatable mkRecdHashWithComparer mkRecdEqualityWithComparer @@ -1023,8 +1054,8 @@ let MakeBindingsForEqualsAugmentation g (tycon:Tycon) = mkLambdas m tps [thisv;thatobjv] (equalse,g.bool_ty) - [ mkCompGenBind nocEqualsVal.Deref nocEqualsExpr; - mkCompGenBind objEqualsVal.Deref objEqualsExpr; ] + [ mkCompGenBind nocEqualsVal.Deref nocEqualsExpr + mkCompGenBind objEqualsVal.Deref objEqualsExpr ] if tycon.IsExceptionDecl then mkEquals mkExnEquality elif tycon.IsUnionTycon then mkEquals mkUnionEquality elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then mkEquals mkRecdEquality diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 5f5a532bbfe..0366f8ce930 100755 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -531,7 +531,7 @@ let UseOfAddressOfOperatorE() = DeclareResourceString("UseOfAddressOfOperator"," let DefensiveCopyWarningE() = DeclareResourceString("DefensiveCopyWarning","%s") let DeprecatedThreadStaticBindingWarningE() = DeclareResourceString("DeprecatedThreadStaticBindingWarning","") let FunctionValueUnexpectedE() = DeclareResourceString("FunctionValueUnexpected","%s") -let UnitTypeExpected1E() = DeclareResourceString("UnitTypeExpected1","%s") +let UnitTypeExpected1E() = DeclareResourceString("UnitTypeExpected1","") let UnitTypeExpected2E() = DeclareResourceString("UnitTypeExpected2","%s") let RecursiveUseCheckedAtRuntimeE() = DeclareResourceString("RecursiveUseCheckedAtRuntime","") let LetRecUnsound1E() = DeclareResourceString("LetRecUnsound1","%s") @@ -621,7 +621,7 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = (if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore ) | ConstraintSolverTypesNotInEqualityRelation(denv,(TType_measure _ as t1),(TType_measure _ as t2),m,m2) -> - // REVIEW: consider if we need to show _cxs (the type parameter constrants) + // REVIEW: consider if we need to show _cxs (the type parameter constraints) let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 os.Append(ConstraintSolverTypesNotInEqualityRelation1E().Format t1 t2 ) |> ignore (if m.StartLine <> m2.StartLine then @@ -633,7 +633,7 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = (if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore) | ConstraintSolverTypesNotInSubsumptionRelation(denv,t1,t2,m,m2) -> - // REVIEW: consider if we need to show _cxs (the type parameter constrants) + // REVIEW: consider if we need to show _cxs (the type parameter constraints) let t1, t2, cxs= NicePrint.minimalStringsOfTwoTypes denv t1 t2 os.Append(ConstraintSolverTypesNotInSubsumptionRelationE().Format t2 t1 cxs) |> ignore (if m.StartLine <> m2.StartLine then @@ -654,9 +654,12 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = match contextInfo with | ContextInfo.OmittedElseBranch -> os.Append(FSComp.SR.missingElseBranch(t2)) |> ignore | ContextInfo.ElseBranch -> os.Append(FSComp.SR.elseBranchHasWrongType(t1,t2)) |> ignore - | ContextInfo.TupleInRecordFields -> + | ContextInfo.TupleInRecordFields -> + os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore + os.Append(System.Environment.NewLine + FSComp.SR.commaInsteadOfSemicolonInRecord()) |> ignore + | _ when t2 = "bool" && t1.EndsWith " ref" -> os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore - os.Append(System.Environment.NewLine + FSComp.SR.commaInsteadOfSemicolonInRecord()) |> ignore + os.Append(System.Environment.NewLine + FSComp.SR.derefInsteadOfNot()) |> ignore | _ -> os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore | ErrorFromAddingTypeEquation(_,_,_,_,((ConstraintSolverTypesNotInSubsumptionRelation _ | ConstraintSolverError _) as e), _, _) -> OutputExceptionR os e @@ -1099,7 +1102,7 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = #if DEBUG if not foundInContext then - Printf.bprintf os ". (no 'in' context found: %+A)" (List.map (List.map Parser.prodIdxToNonTerminal) ctxt.ReducibleProductions); + Printf.bprintf os ". (no 'in' context found: %+A)" (List.map (List.map Parser.prodIdxToNonTerminal) ctxt.ReducibleProductions) #else foundInContext |> ignore // suppress unused variable warning in RELEASE #endif @@ -1182,7 +1185,7 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = if perhapsProp then os.Append(UnitTypeExpected2E().Format (NicePrint.stringOfTy denv ty)) |> ignore else - os.Append(UnitTypeExpected1E().Format (NicePrint.stringOfTy denv ty)) |> ignore + os.Append(UnitTypeExpected1E().Format) |> ignore | RecursiveUseCheckedAtRuntime _ -> os.Append(RecursiveUseCheckedAtRuntimeE().Format) |> ignore | LetRecUnsound (_,[v],_) -> @@ -1254,7 +1257,7 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = | LibraryUseOnly(_) -> os.Append(LibraryUseOnlyE().Format) |> ignore | MissingFields(sl,_) -> os.Append(MissingFieldsE().Format (String.concat "," sl + ".")) |> ignore | ValueRestriction(denv,hassig,v,_,_) -> - let denv = { denv with showImperativeTyparAnnotations=true; } + let denv = { denv with showImperativeTyparAnnotations=true } let tau = v.TauType if hassig then if isFunTy denv.g tau && (arityOfVal v).HasNoArgs then @@ -1473,10 +1476,10 @@ let CollectErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,errorS match err.Exception with | ReportedError _ -> - dprintf "Unexpected ReportedError" (* this should actually never happen *) + assert ("" = "Unexpected ReportedError") // this should never happen Seq.empty | StopProcessing -> - dprintf "Unexpected StopProcessing" (* this should actually never happen *) + assert ("" = "Unexpected StopProcessing") // this should never happen Seq.empty | _ -> let errors = ResizeArray() @@ -1490,8 +1493,8 @@ let CollectErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,errorS let text = match errorStyle with // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. - | ErrorStyle.VSErrors -> sprintf "%s %s FS%04d: " subcategory (if warn then "warning" else "error") errorNumber; - | _ -> sprintf "%s FS%04d: " (if warn then "warning" else "error") (GetErrorNumber err); + | ErrorStyle.VSErrors -> sprintf "%s %s FS%04d: " subcategory (if warn then "warning" else "error") errorNumber + | _ -> sprintf "%s FS%04d: " (if warn then "warning" else "error") (GetErrorNumber err) { ErrorNumber = errorNumber; Subcategory = subcategory; TextRepresentation = text} let mainError,relatedErrors = SplitRelatedErrors err @@ -1499,7 +1502,7 @@ let CollectErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,errorS let canonical = OutputCanonicalInformation(mainError,err.Subcategory(),GetErrorNumber mainError) let message = let os = System.Text.StringBuilder() - OutputPhasedError os mainError flattenErrors; + OutputPhasedError os mainError flattenErrors os.ToString() let entry : DetailedIssueInfo = { Location = where; Canonical = canonical; Message = message } @@ -1568,7 +1571,7 @@ let OutputErrorOrWarningContext prefix fileLineFn os err = let iA = m.StartColumn let iB = m.EndColumn let iLen = if lineA = lineB then max (iB - iA) 1 else 1 - Printf.bprintf os "%s%s\n" prefix line; + Printf.bprintf os "%s%s\n" prefix line Printf.bprintf os "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^') //---------------------------------------------------------------------------- @@ -1576,9 +1579,9 @@ let OutputErrorOrWarningContext prefix fileLineFn os err = let GetFSharpCoreLibraryName () = "FSharp.Core" type internal TypeInThisAssembly = class end -let GetFSharpCoreReferenceUsedByCompiler(useMonoResolution) = +let GetFSharpCoreReferenceUsedByCompiler(useSimpleResolution) = // On Mono, there is no good reference resolution - if useMonoResolution then + if useSimpleResolution then GetFSharpCoreLibraryName()+".dll" else let fsCoreName = GetFSharpCoreLibraryName() @@ -1695,8 +1698,8 @@ let SystemAssemblies primaryAssemblyName = // // REVIEW: it isn't clear if there is any negative effect // of leaving an assembly off this list. -let BasicReferencesForScriptLoadClosure(useMonoResolution, useFsiAuxLib) = - ["mscorlib"; GetFSharpCoreReferenceUsedByCompiler(useMonoResolution) ] @ // Need to resolve these explicitly so they will be found in the reference assemblies directory which is where the .xml files are. +let BasicReferencesForScriptLoadClosure(useSimpleResolution, useFsiAuxLib) = + ["mscorlib"; GetFSharpCoreReferenceUsedByCompiler(useSimpleResolution) ] @ // Need to resolve these explicitly so they will be found in the reference assemblies directory which is where the .xml files are. DefaultBasicReferencesForOutOfProjectSources @ [ if useFsiAuxLib then yield GetFsiLibraryName () ] @@ -1734,7 +1737,7 @@ let GetWarningNumber(m,s:string) = try Some (int32 s) with err -> - warning(Error(FSComp.SR.buildInvalidWarningNumber(s),m)); + warning(Error(FSComp.SR.buildInvalidWarningNumber(s),m)) None let ComputeMakePathAbsolute implicitIncludeDir (path : string) = @@ -1769,7 +1772,7 @@ type VersionFlag = let vstr = x.GetVersionString(implicitIncludeDir) try IL.parseILVersion vstr - with _ -> errorR(Error(FSComp.SR.buildInvalidVersionString(vstr),rangeStartup)) ; IL.parseILVersion "0.0.0.0" + with _ -> errorR(Error(FSComp.SR.buildInvalidVersionString(vstr),rangeStartup)); IL.parseILVersion "0.0.0.0" member x.GetVersionString(implicitIncludeDir) = match x with @@ -1777,7 +1780,7 @@ type VersionFlag = | VersionFile s -> let s = if FileSystem.IsPathRootedShim(s) then s else Path.Combine(implicitIncludeDir,s) if not(FileSystem.SafeExists(s)) then - errorR(Error(FSComp.SR.buildInvalidVersionFile(s),rangeStartup)) ; "0.0.0.0" + errorR(Error(FSComp.SR.buildInvalidVersionFile(s),rangeStartup)); "0.0.0.0" else use is = System.IO.File.OpenText s is.ReadLine() @@ -1834,24 +1837,24 @@ type ResolvedExtensionReference = ResolvedExtensionReference of string * Assembl #endif type ImportedBinary = - { FileName: string; - RawMetadata: IRawFSharpAssemblyData; + { FileName: string + RawMetadata: IRawFSharpAssemblyData #if EXTENSIONTYPING ProviderGeneratedAssembly: System.Reflection.Assembly option - IsProviderGenerated: bool; + IsProviderGenerated: bool ProviderGeneratedStaticLinkMap : ProvidedAssemblyStaticLinkingMap option #endif - ILAssemblyRefs : ILAssemblyRef list; + ILAssemblyRefs : ILAssemblyRef list ILScopeRef: ILScopeRef } type ImportedAssembly = - { ILScopeRef: ILScopeRef; - FSharpViewOfMetadata: CcuThunk; - AssemblyAutoOpenAttributes: string list; - AssemblyInternalsVisibleToAttributes: string list; + { ILScopeRef: ILScopeRef + FSharpViewOfMetadata: CcuThunk + AssemblyAutoOpenAttributes: string list + AssemblyInternalsVisibleToAttributes: string list #if EXTENSIONTYPING IsProviderGenerated: bool - mutable TypeProviders: Tainted list; + mutable TypeProviders: Tainted list #endif FSharpOptimizationData : Microsoft.FSharp.Control.Lazy> } @@ -1963,55 +1966,55 @@ let getSystemRuntimeInitializer (primaryAssembly: PrimaryAssembly) (mkReference type TcConfigBuilder = - { mutable primaryAssembly : PrimaryAssembly; - mutable autoResolveOpenDirectivesToDlls: bool; - mutable noFeedback: bool; - mutable stackReserveSize: int32 option; - mutable implicitIncludeDir: string; (* normally "." *) - mutable openBinariesInMemory: bool; (* false for command line, true for VS *) - mutable openDebugInformationForLaterStaticLinking: bool; (* only for --standalone *) - defaultFSharpBinariesDir: string; - mutable compilingFslib: bool; - mutable compilingFslib20: string option; - mutable compilingFslib40: bool; - mutable useIncrementalBuilder: bool; - mutable includes: string list; - mutable implicitOpens: string list; - mutable useFsiAuxLib: bool; - mutable framework: bool; + { mutable primaryAssembly : PrimaryAssembly + mutable autoResolveOpenDirectivesToDlls: bool + mutable noFeedback: bool + mutable stackReserveSize: int32 option + mutable implicitIncludeDir: string (* normally "." *) + mutable openBinariesInMemory: bool (* false for command line, true for VS *) + mutable openDebugInformationForLaterStaticLinking: bool (* only for --standalone *) + defaultFSharpBinariesDir: string + mutable compilingFslib: bool + mutable compilingFslib20: string option + mutable compilingFslib40: bool + mutable useIncrementalBuilder: bool + mutable includes: string list + mutable implicitOpens: string list + mutable useFsiAuxLib: bool + mutable framework: bool mutable resolutionEnvironment : Microsoft.FSharp.Compiler.MSBuildResolver.ResolutionEnvironment - mutable implicitlyResolveAssemblies: bool; - mutable addVersionSpecificFrameworkReferences: bool; - mutable light: bool option; - mutable conditionalCompilationDefines: string list; - mutable loadedSources: (range * string) list; - mutable referencedDLLs : AssemblyReference list; - mutable projectReferences : IProjectReference list; - mutable knownUnresolvedReferences : UnresolvedAssemblyReference list; - optimizeForMemory: bool; + mutable implicitlyResolveAssemblies: bool + mutable addVersionSpecificFrameworkReferences: bool + mutable light: bool option + mutable conditionalCompilationDefines: string list + mutable loadedSources: (range * string) list + mutable referencedDLLs : AssemblyReference list + mutable projectReferences : IProjectReference list + mutable knownUnresolvedReferences : UnresolvedAssemblyReference list + optimizeForMemory: bool mutable subsystemVersion : int * int mutable useHighEntropyVA : bool - mutable inputCodePage: int option; - mutable embedResources : string list; - mutable globalWarnAsError: bool; - mutable globalWarnLevel: int; - mutable specificWarnOff: int list; - mutable specificWarnOn: int list; + mutable inputCodePage: int option + mutable embedResources : string list + mutable globalWarnAsError: bool + mutable globalWarnLevel: int + mutable specificWarnOff: int list + mutable specificWarnOn: int list mutable specificWarnAsError: int list mutable specificWarnAsWarn : int list - mutable mlCompatibility: bool; - mutable checkOverflow: bool; - mutable showReferenceResolutions:bool; - mutable outputFile : string option; - mutable resolutionFrameworkRegistryBase : string; - mutable resolutionAssemblyFoldersSuffix : string; - mutable resolutionAssemblyFoldersConditions : string; - mutable platform : ILPlatform option; - mutable prefer32Bit : bool; - mutable useMonoResolution : bool + mutable mlCompatibility: bool + mutable checkOverflow: bool + mutable showReferenceResolutions:bool + mutable outputFile : string option + mutable resolutionFrameworkRegistryBase : string + mutable resolutionAssemblyFoldersSuffix : string + mutable resolutionAssemblyFoldersConditions : string + mutable platform : ILPlatform option + mutable prefer32Bit : bool + mutable useSimpleResolution : bool mutable target : CompilerTarget mutable debuginfo : bool - mutable testFlagEmitFeeFeeAs100001 : bool; + mutable testFlagEmitFeeFeeAs100001 : bool mutable dumpDebugInfo : bool mutable debugSymbolFile : string option (* Backend configuration *) @@ -2128,55 +2131,55 @@ type TcConfigBuilder = System.Diagnostics.Debug.Assert(FileSystem.IsPathRootedShim(implicitIncludeDir), sprintf "implicitIncludeDir should be absolute: '%s'" implicitIncludeDir) if (String.IsNullOrEmpty(defaultFSharpBinariesDir)) then failwith "Expected a valid defaultFSharpBinariesDir" - { primaryAssembly = PrimaryAssembly.Mscorlib; // defaut value, can be overridden using the command line switch - light = None; - noFeedback=false; - stackReserveSize=None; - conditionalCompilationDefines=[]; - implicitIncludeDir = implicitIncludeDir; - autoResolveOpenDirectivesToDlls = false; - openBinariesInMemory = false; - openDebugInformationForLaterStaticLinking=false; - defaultFSharpBinariesDir=defaultFSharpBinariesDir; - compilingFslib=false; - compilingFslib20=None; - compilingFslib40=false; - useIncrementalBuilder=false; - useFsiAuxLib=false; - implicitOpens=[]; - includes=[]; + { primaryAssembly = PrimaryAssembly.Mscorlib // defaut value, can be overridden using the command line switch + light = None + noFeedback=false + stackReserveSize=None + conditionalCompilationDefines=[] + implicitIncludeDir = implicitIncludeDir + autoResolveOpenDirectivesToDlls = false + openBinariesInMemory = false + openDebugInformationForLaterStaticLinking=false + defaultFSharpBinariesDir=defaultFSharpBinariesDir + compilingFslib=false + compilingFslib20=None + compilingFslib40=false + useIncrementalBuilder=false + useFsiAuxLib=false + implicitOpens=[] + includes=[] resolutionEnvironment=MSBuildResolver.CompileTimeLike - framework=true; - implicitlyResolveAssemblies=true; - addVersionSpecificFrameworkReferences=false; - referencedDLLs = []; - projectReferences = []; - knownUnresolvedReferences = []; - loadedSources = []; - globalWarnAsError=false; - globalWarnLevel=3; - specificWarnOff=[]; - specificWarnOn=[]; + framework=true + implicitlyResolveAssemblies=true + addVersionSpecificFrameworkReferences=false + referencedDLLs = [] + projectReferences = [] + knownUnresolvedReferences = [] + loadedSources = [] + globalWarnAsError=false + globalWarnLevel=3 + specificWarnOff=[] + specificWarnOn=[] specificWarnAsError=[] specificWarnAsWarn=[] - embedResources = []; - inputCodePage=None; - optimizeForMemory=optimizeForMemory; + embedResources = [] + inputCodePage=None + optimizeForMemory=optimizeForMemory subsystemVersion = 4,0 // per spec for 357994 useHighEntropyVA = false - mlCompatibility=false; - checkOverflow=false; - showReferenceResolutions=false; - outputFile=None; - resolutionFrameworkRegistryBase = "Software\Microsoft\.NetFramework"; - resolutionAssemblyFoldersSuffix = "AssemblyFoldersEx"; - resolutionAssemblyFoldersConditions = ""; - platform = None; - prefer32Bit = false; + mlCompatibility=false + checkOverflow=false + showReferenceResolutions=false + outputFile=None + resolutionFrameworkRegistryBase = "Software\Microsoft\.NetFramework" + resolutionAssemblyFoldersSuffix = "AssemblyFoldersEx" + resolutionAssemblyFoldersConditions = "" + platform = None + prefer32Bit = false #if ENABLE_MONO_SUPPORT - useMonoResolution = runningOnMono + useSimpleResolution = runningOnMono #else - useMonoResolution = false + useSimpleResolution = false #endif target = ConsoleExe debuginfo = false @@ -2249,7 +2252,7 @@ type TcConfigBuilder = lcid = None #endif // See bug 6071 for product banner spec - productNameForBannerText = (FSComp.SR.buildProductName(FSharpEnvironment.DotNetBuildString)) + productNameForBannerText = (FSComp.SR.buildProductName(FSharpEnvironment.FSharpBannerVersion)) showBanner = true showTimes = false showLoadedAssemblies = false @@ -2280,7 +2283,7 @@ type TcConfigBuilder = /// Decide names of output file, pdb and assembly member tcConfigB.DecideNames sourceFiles = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) - if sourceFiles = [] then errorR(Error(FSComp.SR.buildNoInputsSpecified(),rangeCmdArgs)); + if sourceFiles = [] then errorR(Error(FSComp.SR.buildNoInputsSpecified(),rangeCmdArgs)) let ext() = match tcConfigB.target with Dll -> ".dll" | Module -> ".netmodule" | ConsoleExe | WinExe -> ".exe" let implFiles = sourceFiles |> List.filter (fun lower -> List.exists (Filename.checkSuffix (String.lowercase lower)) FSharpImplFileSuffixes) let outfile = @@ -2302,7 +2305,7 @@ type TcConfigBuilder = #if ENABLE_MONO_SUPPORT | Some _ when runningOnMono -> // On Mono, the name of the debug file has to be ".mdb" so specifying it explicitly is an error - warning(Error(FSComp.SR.ilwriteMDBFileNameCannotBeChangedWarning(),rangeCmdArgs)) ; () + warning(Error(FSComp.SR.ilwriteMDBFileNameCannotBeChangedWarning(),rangeCmdArgs)) Microsoft.FSharp.Compiler.AbstractIL.ILPdbWriter.getDebugFileName outfile #endif | Some f -> f) @@ -2319,7 +2322,7 @@ type TcConfigBuilder = | None -> () | Some n -> // nowarn:62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus - if n = 62 then tcConfigB.mlCompatibility <- true; + if n = 62 then tcConfigB.mlCompatibility <- true tcConfigB.specificWarnOff <- ListSet.insert (=) n tcConfigB.specificWarnOff member tcConfigB.TurnWarningOn(m, s:string) = @@ -2328,7 +2331,7 @@ type TcConfigBuilder = | None -> () | Some n -> // warnon 62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus - if n = 62 then tcConfigB.mlCompatibility <- false; + if n = 62 then tcConfigB.mlCompatibility <- false tcConfigB.specificWarnOn <- ListSet.insert (=) n tcConfigB.specificWarnOn member tcConfigB.AddIncludePath (m,path,pathIncludedFrom) = @@ -2339,7 +2342,7 @@ type TcConfigBuilder = with e -> warning(Error(FSComp.SR.buildInvalidSearchDirectory(path),m)); None match existsOpt with | Some(exists) -> - if not exists then warning(Error(FSComp.SR.buildSearchDirectoryNotFound(absolutePath),m)); + if not exists then warning(Error(FSComp.SR.buildSearchDirectoryNotFound(absolutePath),m)) exists | None -> false if ok && not (List.contains absolutePath tcConfigB.includes) then @@ -2406,8 +2409,8 @@ let OpenILBinary(filename,optimizeForMemory,openBinariesInMemory,ilGlobalsOpt, p // fsc.exe does not uses optimizeForMemory (hence keeps MORE caches in AbstractIL) // fsi.exe does use optimizeForMemory (hence keeps FEWER caches in AbstractIL), because its long running // Visual Studio does use optimizeForMemory (hence keeps FEWER caches in AbstractIL), because its long running - ILBinaryReader.optimizeForMemory=optimizeForMemory; - ILBinaryReader.pdbPath = pdbPathOption; } + ILBinaryReader.optimizeForMemory=optimizeForMemory + ILBinaryReader.pdbPath = pdbPathOption } // Visual Studio uses OpenILModuleReaderAfterReadingAllBytes for all DLLs to avoid having to dispose of any readers explicitly if openBinariesInMemory // && not syslib @@ -2528,7 +2531,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = match fileNameOpt with | None -> // if FSharp.Core was not provided explicitly - use version that was referenced by compiler - AssemblyReference(range0, GetFSharpCoreReferenceUsedByCompiler(data.useMonoResolution), None), None + AssemblyReference(range0, GetFSharpCoreReferenceUsedByCompiler(data.useSimpleResolution), None), None | _ -> res let primaryAssemblyCcuInitializer = getSystemRuntimeInitializer data.primaryAssembly (computeKnownDllReference >> fst) @@ -2664,7 +2667,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member x.resolutionAssemblyFoldersConditions = data. resolutionAssemblyFoldersConditions member x.platform = data.platform member x.prefer32Bit = data.prefer32Bit - member x.useMonoResolution = data.useMonoResolution + member x.useSimpleResolution = data.useSimpleResolution member x.target = data.target member x.debuginfo = data.debuginfo member x.testFlagEmitFeeFeeAs100001 = data.testFlagEmitFeeFeeAs100001 @@ -2854,12 +2857,12 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = let sysdir = tcConfig.IsSystemAssembly resolved let fusionName = resolved Some - { originalReference = r; - resolvedPath = resolved; - resolvedFrom = Unknown; - fusionName = fusionName; - redist = null; - sysdir = sysdir; + { originalReference = r + resolvedPath = resolved + resolvedFrom = Unknown + fusionName = fusionName + redist = null + sysdir = sysdir ilAssemblyRef = ref None } | None -> @@ -2892,12 +2895,12 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = with e -> "" Some - { originalReference = r; - resolvedPath = resolved; - resolvedFrom = Unknown; - fusionName = fusionName; - redist = null; - sysdir = sysdir; + { originalReference = r + resolvedPath = resolved + resolvedFrom = Unknown + fusionName = fusionName + redist = null + sysdir = sysdir ilAssemblyRef = ref None } | None -> None else None @@ -2939,7 +2942,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = // NOTE!! if mode=ReportErrors then this method must not raise exceptions. It must just report the errors and recover static member TryResolveLibsUsingMSBuildRules (tcConfig:TcConfig,originalReferences:AssemblyReference list, errorAndWarningRange:range, mode:ResolveAssemblyReferenceMode) : AssemblyResolution list * UnresolvedAssemblyReference list = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) - if tcConfig.useMonoResolution then + if tcConfig.useSimpleResolution then failwith "MSBuild resolution is not supported." if originalReferences=[] then [],[] else @@ -2959,6 +2962,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = let logmessage showMessages = if showMessages && tcConfig.showReferenceResolutions then (fun (message:string)->dprintf "%s\n" message) else ignore + let logwarning showMessages = (fun code message-> if showMessages && mode = ReportErrors then @@ -2972,6 +2976,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = | _ -> (if code = "MSB3245" then errorR else warning) (MSBuildReferenceResolutionWarning(code,message,errorAndWarningRange))) + let logerror showMessages = (fun code message -> if showMessages && mode = ReportErrors then @@ -2985,10 +2990,12 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = | Some(X86) -> "x86" | Some(AMD64) -> "amd64" | Some(IA64) -> "ia64" + let outputDirectory = match tcConfig.outputFile with | Some(outputFile) -> tcConfig.MakePathAbsolute outputFile | None -> tcConfig.implicitIncludeDir + let targetFrameworkDirectories = match tcConfig.clrRoot with | Some(clrRoot) -> [tcConfig.MakePathAbsolute clrRoot] @@ -3030,6 +3037,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = |> Array.map(fun i->(p13 groupedReferences.[i]),(p23 groupedReferences.[i]),i) |> Array.filter (fun (_,i0,_)->resolvedAsFile|>Array.exists(fun (i1,_) -> i0=i1)|>not) |> Array.map(fun (ref,_,i)->ref,string i) + let resolutions = Resolve(toMsBuild,(*showMessages*)true) // Map back to original assembly resolutions. @@ -3042,12 +3050,12 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = ms|>List.map(fun originalReference -> System.Diagnostics.Debug.Assert(FileSystem.IsPathRootedShim(resolvedFile.itemSpec), sprintf "msbuild-resolved path is not absolute: '%s'" resolvedFile.itemSpec) let canonicalItemSpec = FileSystem.GetFullPathShim(resolvedFile.itemSpec) - {originalReference=originalReference; - resolvedPath=canonicalItemSpec; - resolvedFrom=resolvedFile.resolvedFrom; + {originalReference=originalReference + resolvedPath=canonicalItemSpec + resolvedFrom=resolvedFile.resolvedFrom fusionName=resolvedFile.fusionName - redist=resolvedFile.redist; - sysdir= tcConfig.IsSystemAssembly canonicalItemSpec; + redist=resolvedFile.redist + sysdir= tcConfig.IsSystemAssembly canonicalItemSpec ilAssemblyRef = ref None}) (maxIndexOfReference, assemblyResolutions)) @@ -3146,7 +3154,7 @@ type ErrorLoggerFilteringByScopedPragmas (checkFile,scopedPragmas,errorLogger:Er (not checkFile || m.FileIndex = pragmaRange.FileIndex) && Range.posGeq m.Start pragmaRange.Start)) | None -> true - if report then errorLogger.WarnSink(err); + if report then errorLogger.WarnSink(err) override x.ErrorNumbers = errorLogger.ErrorNumbers override x.WarningNumbers = errorLogger.WarningNumbers @@ -3338,7 +3346,7 @@ let ParseInput (lexer,errorLogger:ErrorLogger,lexbuf:UnicodeLexing.Lexbuf,defaul try let input = if mlCompatSuffixes |> List.exists (Filename.checkSuffix lower) then - mlCompatWarning (FSComp.SR.buildCompilingExtensionIsForML()) rangeStartup; + mlCompatWarning (FSComp.SR.buildCompilingExtensionIsForML()) rangeStartup if FSharpImplFileSuffixes |> List.exists (Filename.checkSuffix lower) then let impl = Parser.implementationFile lexer lexbuf @@ -3368,23 +3376,23 @@ let ParseOneInputLexbuf (tcConfig:TcConfig,lexResourceManager,conditionalCompila let shortFilename = SanitizeFileName filename tcConfig.implicitIncludeDir let input = Lexhelp.usingLexbufForParsing (lexbuf,filename) (fun lexbuf -> - if verbose then dprintn ("Parsing... "+shortFilename); + if verbose then dprintn ("Parsing... "+shortFilename) let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs skip, lexbuf) if tcConfig.tokenizeOnly then while true do - printf "tokenize - getting one token from %s\n" shortFilename; + printf "tokenize - getting one token from %s\n" shortFilename let t = tokenizer.Lexer lexbuf - printf "tokenize - got %s @ %a\n" (Parser.token_to_string t) outputRange lexbuf.LexemeRange; - (match t with Parser.EOF _ -> exit 0 | _ -> ()); + printf "tokenize - got %s @ %a\n" (Parser.token_to_string t) outputRange lexbuf.LexemeRange + (match t with Parser.EOF _ -> exit 0 | _ -> ()) if lexbuf.IsPastEndOfStream then printf "!!! at end of stream\n" if tcConfig.testInteractionParser then while true do match (Parser.interaction tokenizer.Lexer lexbuf) with - | IDefns(l,m) -> dprintf "Parsed OK, got %d defs @ %a\n" l.Length outputRange m; - | IHash (_,m) -> dprintf "Parsed OK, got hash @ %a\n" outputRange m; - exit 0; + | IDefns(l,m) -> dprintf "Parsed OK, got %d defs @ %a\n" l.Length outputRange m + | IHash (_,m) -> dprintf "Parsed OK, got hash @ %a\n" outputRange m + exit 0 let res = ParseInput(tokenizer.Lexer,errorLogger,lexbuf,None,filename,isLastCompiland) @@ -3403,7 +3411,7 @@ let ParseOneInputLexbuf (tcConfig:TcConfig,lexResourceManager,conditionalCompila dprintf "parsing yielded %d definitions" (List.collect flattenModImpl impls).Length res ) - if verbose then dprintn ("Parsed "+shortFilename); + if verbose then dprintn ("Parsed "+shortFilename) Some input with e -> (* errorR(Failure("parse failed")); *) errorRecovery e rangeStartup; None @@ -3442,7 +3450,7 @@ type TcAssemblyResolutions(results : AssemblyResolution list, unresolved : Unres static member Resolve (tcConfig:TcConfig,assemblyList:AssemblyReference list, knownUnresolved:UnresolvedAssemblyReference list) : TcAssemblyResolutions = let resolved,unresolved = - if tcConfig.useMonoResolution then + if tcConfig.useSimpleResolution then let resolutions = assemblyList |> List.map (fun assemblyReference -> @@ -3544,17 +3552,17 @@ type ILResource with | _-> error(InternalError("UnpickleFromResource",m)) let MakeILResource rname bytes = - { Name = rname; - Location = ILResourceLocation.Local (fun () -> bytes); - Access = ILResourceAccess.Public; + { Name = rname + Location = ILResourceLocation.Local (fun () -> bytes) + Access = ILResourceAccess.Public CustomAttrs = emptyILCustomAttrs } #if NO_COMPILER_BACKEND #else let PickleToResource file g scope rname p x = - { Name = rname; - Location = (let bytes = pickleObjWithDanglingCcus file g scope p x in ILResourceLocation.Local (fun () -> bytes)); - Access = ILResourceAccess.Public; + { Name = rname + Location = (let bytes = pickleObjWithDanglingCcus file g scope p x in ILResourceLocation.Local (fun () -> bytes)) + Access = ILResourceAccess.Public CustomAttrs = emptyILCustomAttrs } #endif @@ -3567,8 +3575,8 @@ let WriteSignatureData (tcConfig:TcConfig,tcGlobals,exportRemapping,ccu:CcuThunk let mspec = ccu.Contents let mspec = ApplyExportRemappingToEntity tcGlobals exportRemapping mspec PickleToResource file tcGlobals ccu (FSharpSignatureDataResourceName+"."+ccu.AssemblyName) pickleCcuInfo - { mspec=mspec; - compileTimeWorkingDir=tcConfig.implicitIncludeDir; + { mspec=mspec + compileTimeWorkingDir=tcConfig.implicitIncludeDir usesQuotations = ccu.UsesFSharp20PlusQuotations } #endif // NO_COMPILER_BACKEND @@ -3579,7 +3587,7 @@ let GetOptimizationData (file, ilScopeRef, ilModule, byteReader) = #else let WriteOptimizationData (tcGlobals, file, ccu,modulInfo) = #if DEBUG - if verbose then dprintf "Optimization data after remap:\n%s\n" (Layout.showL (Layout.squashTo 192 (Optimizer.moduleInfoL tcGlobals modulInfo))); + if verbose then dprintf "Optimization data after remap:\n%s\n" (Layout.showL (Layout.squashTo 192 (Optimizer.moduleInfoL tcGlobals modulInfo))) #endif PickleToResource file tcGlobals ccu (FSharpOptimizationDataResourceName+"."+ccu.AssemblyName) Optimizer.p_CcuOptimizationInfo modulInfo #endif @@ -3606,9 +3614,9 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR if List.contains ilShortAssemName externalSigAndOptData then let sigFileName = Path.ChangeExtension(filename, "sigdata") if not sigDataReaders.IsEmpty then - error(Error(FSComp.SR.buildDidNotExpectSigdataResource(),m)); + error(Error(FSComp.SR.buildDidNotExpectSigdataResource(),m)) if not (FileSystem.SafeExists sigFileName) then - error(Error(FSComp.SR.buildExpectedSigdataFile(), m)); + error(Error(FSComp.SR.buildExpectedSigdataFile(), m)) [ (ilShortAssemName, FileSystem.ReadAllBytesShim sigFileName)] else sigDataReaders @@ -3623,9 +3631,9 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR if List.contains ilShortAssemName externalSigAndOptData then let optDataFile = Path.ChangeExtension(filename, "optdata") if not optDataReaders.IsEmpty then - error(Error(FSComp.SR.buildDidNotExpectOptDataResource(),m)); + error(Error(FSComp.SR.buildDidNotExpectOptDataResource(),m)) if not (FileSystem.SafeExists optDataFile) then - error(Error(FSComp.SR.buildExpectedFileAlongSideFSharpCore(optDataFile),m)); + error(Error(FSComp.SR.buildExpectedFileAlongSideFSharpCore(optDataFile),m)) [ (ilShortAssemName, (fun () -> FileSystem.ReadAllBytesShim optDataFile))] else optDataReaders @@ -3726,13 +3734,13 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti member tcImports.RegisterCcu(ccuInfo) = CheckDisposed() - ccuInfos <- ccuInfos ++ ccuInfo; + ccuInfos <- ccuInfos ++ ccuInfo // Assembly Ref Resolution: remove this use of ccu.AssemblyName ccuTable <- NameMap.add (ccuInfo.FSharpViewOfMetadata.AssemblyName) ccuInfo ccuTable member tcImports.RegisterDll(dllInfo) = CheckDisposed() - dllInfos <- dllInfos ++ dllInfo; + dllInfos <- dllInfos ++ dllInfo dllTable <- NameMap.add (getNameOfScopeRef dllInfo.ILScopeRef) dllInfo dllTable member tcImports.GetDllInfos() = @@ -3760,7 +3768,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti match look tcImports with | Some res -> Some res | None -> - tcImports.ImplicitLoadIfAllowed(m,assemblyName,lookupOnly); + tcImports.ImplicitLoadIfAllowed(m,assemblyName,lookupOnly) look tcImports @@ -3797,7 +3805,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti match look tcImports with | Some res -> ResolvedImportedAssembly(res) | None -> - tcImports.ImplicitLoadIfAllowed(m,assemblyName,lookupOnly); + tcImports.ImplicitLoadIfAllowed(m,assemblyName,lookupOnly) match look tcImports with | Some res -> ResolvedImportedAssembly(res) | None -> UnresolvedImportedAssembly(assemblyName) @@ -3846,16 +3854,16 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let theActualAssembly = assembly.PUntaint((fun x -> x.Handle),m) let dllinfo = { RawMetadata= RawFSharpAssemblyDataBackedByFileOnDisk (ilModule, ilAssemblyRefs) - FileName=fileName; + FileName=fileName ProviderGeneratedAssembly=Some theActualAssembly - IsProviderGenerated=true; + IsProviderGenerated=true ProviderGeneratedStaticLinkMap= if g.isInteractive then None else Some (ProvidedAssemblyStaticLinkingMap.CreateNew()) - ILScopeRef = ilScopeRef; + ILScopeRef = ilScopeRef ILAssemblyRefs = ilAssemblyRefs } - tcImports.RegisterDll(dllinfo); + tcImports.RegisterDll(dllinfo) let ccuData : CcuData = - { IsFSharp=false; - UsesFSharp20PlusQuotations=false; + { IsFSharp=false + UsesFSharp20PlusQuotations=false InvalidateEvent=(new Event<_>()).Publish IsProviderGenerated = true QualifiedName= Some (assembly.PUntaint((fun a -> a.FullName), m)) @@ -4118,7 +4126,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti match providers with | [] -> - warning(Error(FSComp.SR.etHostingAssemblyFoundWithoutHosts(fileNameOfRuntimeAssembly,typeof.FullName),m)); + warning(Error(FSComp.SR.etHostingAssemblyFoundWithoutHosts(fileNameOfRuntimeAssembly,typeof.FullName),m)) | _ -> if typeProviderEnvironment.showResolutionMessages then @@ -4241,9 +4249,9 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let dir = minfo.compileTimeWorkingDir let knownLibraryLocation = @"src\fsharp\" // Help highlighting... " let knownLibarySuffixes = - [ @"FSharp.Core"; - @"FSharp.PowerPack"; - @"FSharp.PowerPack.Linq"; + [ @"FSharp.Core" + @"FSharp.PowerPack" + @"FSharp.PowerPack.Linq" @"FSharp.PowerPack.Metadata" ] match knownLibarySuffixes |> List.tryFind (fun x -> dir.EndsWith(knownLibraryLocation + x,StringComparison.OrdinalIgnoreCase)) with | None -> @@ -4441,7 +4449,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti | Some assemblyResolution -> ResultD [assemblyResolution] | None -> - if tcConfigP.Get().useMonoResolution then + if tcConfigP.Get().useSimpleResolution then let action = match mode with | ResolveAssemblyReferenceMode.ReportErrors -> CcuLoadFailureAction.RaiseError @@ -4715,7 +4723,7 @@ let ProcessMetaCommandsFromInput | _ -> - (* warning(Error("This meta-command has been ignored",m)); *) + (* warning(Error("This meta-command has been ignored",m)) *) state with e -> errorRecovery e matchedm; state @@ -4849,7 +4857,7 @@ module private ScriptPreprocessClosure = ParseOneInputLexbuf (tcConfig,lexResourceManager,defines,lexbuf,filename,isLastCompiland,errorLogger) /// Create a TcConfig for load closure starting from a single .fsx file - let CreateScriptSourceTcConfig (filename:string, codeContext, useMonoResolution, useFsiAuxLib, basicReferences, applyCommandLineArgs) = + let CreateScriptSourceTcConfig (filename:string, codeContext, useSimpleResolution, useFsiAuxLib, basicReferences, applyCommandLineArgs) = let projectDir = Path.GetDirectoryName(filename) let isInteractive = (codeContext = CodeContext.Evaluation) let isInvalidationSupported = (codeContext = CodeContext.Editing) @@ -4857,7 +4865,7 @@ module private ScriptPreprocessClosure = let tcConfigB = TcConfigBuilder.CreateNew(Internal.Utilities.FSharpEnvironment.BinFolderOfDefaultFSharpCompiler.Value, true (* optimize for memory *), projectDir, isInteractive, isInvalidationSupported) applyCommandLineArgs tcConfigB match basicReferences with - | None -> BasicReferencesForScriptLoadClosure(useMonoResolution, useFsiAuxLib) |> List.iter(fun f->tcConfigB.AddReferencedAssemblyByPath(range0,f)) // Add script references + | None -> BasicReferencesForScriptLoadClosure(useSimpleResolution, useFsiAuxLib) |> List.iter(fun f->tcConfigB.AddReferencedAssemblyByPath(range0,f)) // Add script references | Some rs -> for m,r in rs do tcConfigB.AddReferencedAssemblyByPath(m,r) tcConfigB.resolutionEnvironment <- @@ -5018,18 +5026,18 @@ module private ScriptPreprocessClosure = result /// Given source text, find the full load closure. Used from service.fs, when editing a script file - let GetFullClosureOfScriptSource(filename,source,codeContext,useMonoResolution,useFsiAuxLib,lexResourceManager:Lexhelp.LexResourceManager,applyCommmandLineArgs) = + let GetFullClosureOfScriptSource(filename,source,codeContext,useSimpleResolution,useFsiAuxLib,lexResourceManager:Lexhelp.LexResourceManager,applyCommmandLineArgs) = // Resolve the basic references such as FSharp.Core.dll first, before processing any #I directives in the script // // This is tries to mimic the action of running the script in F# Interactive - the initial context for scripting is created // first, then #I and other directives are processed. let references0 = - let tcConfig = CreateScriptSourceTcConfig(filename,codeContext,useMonoResolution,useFsiAuxLib,None,applyCommmandLineArgs) + let tcConfig = CreateScriptSourceTcConfig(filename,codeContext,useSimpleResolution,useFsiAuxLib,None,applyCommmandLineArgs) let resolutions0,_unresolvedReferences = GetAssemblyResolutionInformation(tcConfig) let references0 = resolutions0 |> List.map (fun r->r.originalReference.Range,r.resolvedPath) |> Seq.distinct |> List.ofSeq references0 - let tcConfig = CreateScriptSourceTcConfig(filename,codeContext,useMonoResolution,useFsiAuxLib,Some references0,applyCommmandLineArgs) + let tcConfig = CreateScriptSourceTcConfig(filename,codeContext,useSimpleResolution,useFsiAuxLib,Some references0,applyCommmandLineArgs) let protoClosure = [SourceFile(filename,range0,source)] let finalClosure,tcConfig = FindClosureDirectives(protoClosure,tcConfig,codeContext,lexResourceManager) @@ -5045,9 +5053,9 @@ module private ScriptPreprocessClosure = type LoadClosure with // Used from service.fs, when editing a script file - static member ComputeClosureOfSourceText(filename:string, source:string, codeContext, useMonoResolution:bool, useFsiAuxLib, lexResourceManager:Lexhelp.LexResourceManager, applyCommmandLineArgs) : LoadClosure = + static member ComputeClosureOfSourceText(filename:string, source:string, codeContext, useSimpleResolution:bool, useFsiAuxLib, lexResourceManager:Lexhelp.LexResourceManager, applyCommmandLineArgs) : LoadClosure = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) - ScriptPreprocessClosure.GetFullClosureOfScriptSource(filename,source,codeContext,useMonoResolution,useFsiAuxLib, lexResourceManager, applyCommmandLineArgs) + ScriptPreprocessClosure.GetFullClosureOfScriptSource(filename,source,codeContext,useSimpleResolution,useFsiAuxLib, lexResourceManager, applyCommmandLineArgs) /// Used from fsi.fs and fsc.fs, for #load and command line. /// The resulting references are then added to a TcConfig. diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index b80b4dfc236..9ff4d4adafe 100755 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -273,7 +273,7 @@ type TcConfigBuilder = mutable resolutionAssemblyFoldersConditions : string mutable platform : ILPlatform option mutable prefer32Bit : bool - mutable useMonoResolution : bool + mutable useSimpleResolution : bool mutable target : CompilerTarget mutable debuginfo : bool mutable testFlagEmitFeeFeeAs100001 : bool @@ -425,7 +425,7 @@ type TcConfig = member resolutionAssemblyFoldersConditions : string member platform : ILPlatform option member prefer32Bit : bool - member useMonoResolution : bool + member useSimpleResolution : bool member target : CompilerTarget member debuginfo : bool member testFlagEmitFeeFeeAs100001 : bool @@ -775,7 +775,7 @@ type LoadClosure = RootWarnings : PhasedError list } // Used from service.fs, when editing a script file - static member ComputeClosureOfSourceText : filename: string * source: string * implicitDefines:CodeContext * useMonoResolution: bool * useFsiAuxLib: bool * lexResourceManager: Lexhelp.LexResourceManager * applyCompilerOptions: (TcConfigBuilder -> unit) -> LoadClosure + static member ComputeClosureOfSourceText : filename: string * source: string * implicitDefines:CodeContext * useSimpleResolution: bool * useFsiAuxLib: bool * lexResourceManager: Lexhelp.LexResourceManager * applyCompilerOptions: (TcConfigBuilder -> unit) -> LoadClosure /// Used from fsi.fs and fsc.fs, for #load and command line. The resulting references are then added to a TcConfig. static member ComputeClosureOfSourceFiles : tcConfig:TcConfig * (string * range) list * implicitDefines:CodeContext * useDefaultScriptingReferences : bool * lexResourceManager : Lexhelp.LexResourceManager -> LoadClosure diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 11a178d9cea..45e95ef3408 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -107,7 +107,7 @@ let compilerOptionUsage (CompilerOption(s,tag,spec,_,_)) = | OptionGeneral _ -> if tag="" then sprintf "%s" s else sprintf "%s:%s" s tag (* still being decided *) let PrintCompilerOption (CompilerOption(_s,_tag,_spec,_,help) as compilerOption) = - let flagWidth = 30 // fixed width for printing of flags, e.g. --warnaserror: + let flagWidth = 30 // fixed width for printing of flags, e.g. --warnaserror: let defaultLineWidth = 80 // the fallback width let lineWidth = try @@ -588,45 +588,45 @@ let outputFileFlagsFsc (tcConfigB : TcConfigBuilder) = Some (FSComp.SR.optsNameOfOutputFile()) ); CompilerOption("target", tagExe, OptionString (SetTarget tcConfigB), None, - Some (FSComp.SR.optsBuildConsole())); + Some (FSComp.SR.optsBuildConsole())) CompilerOption("target", tagWinExe, OptionString (SetTarget tcConfigB), None, - Some (FSComp.SR.optsBuildWindows())); + Some (FSComp.SR.optsBuildWindows())) CompilerOption("target", tagLibrary, OptionString (SetTarget tcConfigB), None, - Some (FSComp.SR.optsBuildLibrary())); + Some (FSComp.SR.optsBuildLibrary())) CompilerOption("target", tagModule, OptionString (SetTarget tcConfigB), None, - Some (FSComp.SR.optsBuildModule())); + Some (FSComp.SR.optsBuildModule())) CompilerOption("delaysign", tagNone, OptionSwitch (fun s -> tcConfigB.delaysign <- (s = OptionSwitch.On)), None, - Some (FSComp.SR.optsDelaySign())); + Some (FSComp.SR.optsDelaySign())) CompilerOption("publicsign", tagNone, OptionSwitch (fun s -> tcConfigB.publicsign <- (s = OptionSwitch.On)), None, - Some (FSComp.SR.optsPublicSign())); + Some (FSComp.SR.optsPublicSign())) CompilerOption("doc", tagFile, OptionString (fun s -> tcConfigB.xmlDocOutputFile <- Some s), None, - Some (FSComp.SR.optsWriteXml())); + Some (FSComp.SR.optsWriteXml())) CompilerOption("keyfile", tagFile, OptionString (fun s -> tcConfigB.signer <- Some(s)), None, - Some (FSComp.SR.optsStrongKeyFile())); + Some (FSComp.SR.optsStrongKeyFile())) CompilerOption("keycontainer", tagString, OptionString(fun s -> tcConfigB.container <- Some(s)),None, - Some(FSComp.SR.optsStrongKeyContainer())); + Some(FSComp.SR.optsStrongKeyContainer())) CompilerOption("platform", tagString, OptionString (fun s -> tcConfigB.platform <- match s with | "x86" -> Some X86 | "x64" -> Some AMD64 | "Itanium" -> Some IA64 | "anycpu32bitpreferred" -> (tcConfigB.prefer32Bit <- true; None) | "anycpu" -> None | _ -> error(Error(FSComp.SR.optsUnknownPlatform(s),rangeCmdArgs))), None, - Some(FSComp.SR.optsPlatform())) ; + Some(FSComp.SR.optsPlatform())) CompilerOption("nooptimizationdata", tagNone, OptionUnit (fun () -> tcConfigB.onlyEssentialOptimizationData <- true), None, - Some (FSComp.SR.optsNoOpt())); + Some (FSComp.SR.optsNoOpt())) CompilerOption("nointerfacedata", tagNone, OptionUnit (fun () -> tcConfigB.noSignatureData <- true), None, - Some (FSComp.SR.optsNoInterface())); + Some (FSComp.SR.optsNoInterface())) CompilerOption("sig", tagFile, OptionString (setSignatureFile tcConfigB), None, - Some (FSComp.SR.optsSig())); + Some (FSComp.SR.optsSig())) - CompilerOption("nocopyfsharpcore", tagNone, OptionUnit (fun () -> tcConfigB.copyFSharpCore <- false), None, Some (FSComp.SR.optsNoCopyFsharpCore())); + CompilerOption("nocopyfsharpcore", tagNone, OptionUnit (fun () -> tcConfigB.copyFSharpCore <- false), None, Some (FSComp.SR.optsNoCopyFsharpCore())) ] @@ -637,41 +637,41 @@ let resourcesFlagsFsi (_tcConfigB : TcConfigBuilder) = [] let resourcesFlagsFsc (tcConfigB : TcConfigBuilder) = [ CompilerOption("win32res", tagFile, OptionString (fun s -> tcConfigB.win32res <- s), None, - Some (FSComp.SR.optsWin32res())); + Some (FSComp.SR.optsWin32res())) CompilerOption("win32manifest", tagFile, OptionString (fun s -> tcConfigB.win32manifest <- s), None, - Some (FSComp.SR.optsWin32manifest())); + Some (FSComp.SR.optsWin32manifest())) CompilerOption("nowin32manifest", tagNone, OptionUnit (fun () -> tcConfigB.includewin32manifest <- false), None, - Some (FSComp.SR.optsNowin32manifest())); + Some (FSComp.SR.optsNowin32manifest())) CompilerOption("resource", tagResInfo, OptionString (fun s -> tcConfigB.AddEmbeddedResource s), None, - Some (FSComp.SR.optsResource())); + Some (FSComp.SR.optsResource())) CompilerOption("linkresource", tagResInfo, OptionString (fun s -> tcConfigB.linkResources <- tcConfigB.linkResources ++ s), None, - Some (FSComp.SR.optsLinkresource())); + Some (FSComp.SR.optsLinkresource())) ] // OptionBlock: Code generation //----------------------------- -let codeGenerationFlags (tcConfigB : TcConfigBuilder) = +let codeGenerationFlags isFsi (tcConfigB : TcConfigBuilder) = [ CompilerOption("debug", tagNone, OptionSwitch (SetDebugSwitch tcConfigB None), None, - Some (FSComp.SR.optsDebugPM())); + Some (FSComp.SR.optsDebugPM())) CompilerOption("debug", tagFullPDBOnlyPortable, OptionString (fun s -> SetDebugSwitch tcConfigB (Some(s)) OptionSwitch.On), None, - Some (FSComp.SR.optsDebug())); + Some (FSComp.SR.optsDebug(if isFsi then "pdbonly" else "full"))) CompilerOption("optimize", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB) , None, - Some (FSComp.SR.optsOptimize())); + Some (FSComp.SR.optsOptimize())) CompilerOption("tailcalls", tagNone, OptionSwitch (SetTailcallSwitch tcConfigB), None, - Some (FSComp.SR.optsTailcalls())); + Some (FSComp.SR.optsTailcalls())) CompilerOption("crossoptimize", tagNone, OptionSwitch (crossOptimizeSwitch tcConfigB), None, - Some (FSComp.SR.optsCrossoptimize())); + Some (FSComp.SR.optsCrossoptimize())) ] @@ -687,9 +687,9 @@ let mlCompatibilityFlag (tcConfigB : TcConfigBuilder) = let languageFlags tcConfigB = [ CompilerOption("checked", tagNone, OptionSwitch (fun switch -> tcConfigB.checkOverflow <- (switch = OptionSwitch.On)), None, - Some (FSComp.SR.optsChecked())); + Some (FSComp.SR.optsChecked())) CompilerOption("define", tagString, OptionString (defineSymbol tcConfigB), None, - Some (FSComp.SR.optsDefine())); + Some (FSComp.SR.optsDefine())) mlCompatibilityFlag tcConfigB ] @@ -717,7 +717,7 @@ let codePageFlag (tcConfigB : TcConfigBuilder) = #if PREFERRED_UI_LANG let preferredUiLang (tcConfigB: TcConfigBuilder) = - CompilerOption("preferreduilang", tagString, OptionString (fun s -> tcConfigB.preferredUiLang <- Some(s)), None, Some(FSComp.SR.optsStrongKeyContainer())); + CompilerOption("preferreduilang", tagString, OptionString (fun s -> tcConfigB.preferredUiLang <- Some(s)), None, Some(FSComp.SR.optsStrongKeyContainer())) #endif let utf8OutputFlag (tcConfigB: TcConfigBuilder) = @@ -734,18 +734,18 @@ let cliRootFlag (_tcConfigB : TcConfigBuilder) = let advancedFlagsBoth tcConfigB = [ - codePageFlag tcConfigB; - utf8OutputFlag tcConfigB; + codePageFlag tcConfigB + utf8OutputFlag tcConfigB #if PREFERRED_UI_LANG - preferredUiLang tcConfigB; + preferredUiLang tcConfigB #endif - fullPathsFlag tcConfigB; - libFlag tcConfigB; + fullPathsFlag tcConfigB + libFlag tcConfigB ] let noFrameworkFlag isFsc tcConfigB = CompilerOption("noframework", tagNone, OptionUnit (fun () -> - tcConfigB.framework <- false; + tcConfigB.framework <- false if isFsc then tcConfigB.implicitlyResolveAssemblies <- false), None, Some (FSComp.SR.optsNoframework())) @@ -761,27 +761,27 @@ let setTargetProfile tcConfigB v = let advancedFlagsFsc tcConfigB = advancedFlagsBoth tcConfigB @ [ - yield CompilerOption("baseaddress", tagAddress, OptionString (fun s -> tcConfigB.baseAddress <- Some(int32 s)), None, Some (FSComp.SR.optsBaseaddress())); - yield noFrameworkFlag true tcConfigB; + yield CompilerOption("baseaddress", tagAddress, OptionString (fun s -> tcConfigB.baseAddress <- Some(int32 s)), None, Some (FSComp.SR.optsBaseaddress())) + yield noFrameworkFlag true tcConfigB yield CompilerOption("standalone", tagNone, OptionUnit (fun _ -> - tcConfigB.openDebugInformationForLaterStaticLinking <- true; - tcConfigB.standalone <- true; + tcConfigB.openDebugInformationForLaterStaticLinking <- true + tcConfigB.standalone <- true tcConfigB.implicitlyResolveAssemblies <- true), None, - Some (FSComp.SR.optsStandalone())); + Some (FSComp.SR.optsStandalone())) yield CompilerOption("staticlink", tagFile, OptionString (fun s -> tcConfigB.extraStaticLinkRoots <- tcConfigB.extraStaticLinkRoots @ [s]), None, - Some (FSComp.SR.optsStaticlink())); + Some (FSComp.SR.optsStaticlink())) #if ENABLE_MONO_SUPPORT if runningOnMono then yield CompilerOption("resident", tagFile, OptionUnit (fun () -> ()), None, - Some (FSComp.SR.optsResident())); + Some (FSComp.SR.optsResident())) #endif yield CompilerOption("pdb", tagString, OptionString (fun s -> tcConfigB.debugSymbolFile <- Some s), None, - Some (FSComp.SR.optsPdb())); - yield CompilerOption("simpleresolution", tagNone, OptionUnit (fun () -> tcConfigB.useMonoResolution<-true), None, - Some (FSComp.SR.optsSimpleresolution())); + Some (FSComp.SR.optsPdb())) + yield CompilerOption("simpleresolution", tagNone, OptionUnit (fun () -> tcConfigB.useSimpleResolution<-true), None, + Some (FSComp.SR.optsSimpleresolution())) yield CompilerOption("highentropyva", tagNone, OptionSwitch (useHighEntropyVASwitch tcConfigB), None, Some (FSComp.SR.optsUseHighEntropyVA())) yield CompilerOption("subsystemversion", tagString, OptionString (subSystemVersionSwitch tcConfigB), None, Some (FSComp.SR.optsSubSystemVersion())) yield CompilerOption("targetprofile", tagString, OptionString (setTargetProfile tcConfigB), None, Some(FSComp.SR.optsTargetProfile())) @@ -811,70 +811,70 @@ let testFlag tcConfigB = // not shown in fsc.exe help, no warning on use, motiviation is for use from VS let vsSpecificFlags (tcConfigB: TcConfigBuilder) = - [ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.VSErrors), None, None); - CompilerOption("validate-type-providers", tagNone, OptionUnit (id), None, None); // preserved for compatibility's sake, no longer has any effect + [ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.VSErrors), None, None) + CompilerOption("validate-type-providers", tagNone, OptionUnit (id), None, None) // preserved for compatibility's sake, no longer has any effect #if PREFERRED_UI_LANG - CompilerOption("LCID", tagInt, OptionInt (fun _n -> ()), None, None); + CompilerOption("LCID", tagInt, OptionInt (fun _n -> ()), None, None) #else - CompilerOption("LCID", tagInt, OptionInt (fun n -> tcConfigB.lcid <- Some(n)), None, None); + CompilerOption("LCID", tagInt, OptionInt (fun n -> tcConfigB.lcid <- Some(n)), None, None) #endif - CompilerOption("flaterrors", tagNone, OptionUnit (fun () -> tcConfigB.flatErrors <- true), None, None); - CompilerOption("sqmsessionguid", tagNone, OptionString (fun s -> tcConfigB.sqmSessionGuid <- try System.Guid(s) |> Some with e -> None), None, None); - CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.GccErrors), None, None); - CompilerOption("exename", tagNone, OptionString (fun s -> tcConfigB.exename <- Some(s)), None, None); - CompilerOption("maxerrors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), None, None); ] + CompilerOption("flaterrors", tagNone, OptionUnit (fun () -> tcConfigB.flatErrors <- true), None, None) + CompilerOption("sqmsessionguid", tagNone, OptionString (fun s -> tcConfigB.sqmSessionGuid <- try System.Guid(s) |> Some with e -> None), None, None) + CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.GccErrors), None, None) + CompilerOption("exename", tagNone, OptionString (fun s -> tcConfigB.exename <- Some(s)), None, None) + CompilerOption("maxerrors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), None, None) ] let internalFlags (tcConfigB:TcConfigBuilder) = [ - CompilerOption("stamps", tagNone, OptionUnit (fun () -> ()), Some(InternalCommandLineOption("--stamps", rangeCmdArgs)), None); - CompilerOption("ranges", tagNone, OptionSet Tastops.DebugPrint.layoutRanges, Some(InternalCommandLineOption("--ranges", rangeCmdArgs)), None); - CompilerOption("terms" , tagNone, OptionUnit (fun () -> tcConfigB.showTerms <- true), Some(InternalCommandLineOption("--terms", rangeCmdArgs)), None); - CompilerOption("termsfile" , tagNone, OptionUnit (fun () -> tcConfigB.writeTermsToFiles <- true), Some(InternalCommandLineOption("--termsfile", rangeCmdArgs)), None); + CompilerOption("stamps", tagNone, OptionUnit (fun () -> ()), Some(InternalCommandLineOption("--stamps", rangeCmdArgs)), None) + CompilerOption("ranges", tagNone, OptionSet Tastops.DebugPrint.layoutRanges, Some(InternalCommandLineOption("--ranges", rangeCmdArgs)), None) + CompilerOption("terms" , tagNone, OptionUnit (fun () -> tcConfigB.showTerms <- true), Some(InternalCommandLineOption("--terms", rangeCmdArgs)), None) + CompilerOption("termsfile" , tagNone, OptionUnit (fun () -> tcConfigB.writeTermsToFiles <- true), Some(InternalCommandLineOption("--termsfile", rangeCmdArgs)), None) #if DEBUG - CompilerOption("debug-parse", tagNone, OptionUnit (fun () -> Internal.Utilities.Text.Parsing.Flags.debug <- true), Some(InternalCommandLineOption("--debug-parse", rangeCmdArgs)), None); - CompilerOption("ilfiles", tagNone, OptionUnit (fun () -> tcConfigB.writeGeneratedILFiles <- true), Some(InternalCommandLineOption("--ilfiles", rangeCmdArgs)), None); + CompilerOption("debug-parse", tagNone, OptionUnit (fun () -> Internal.Utilities.Text.Parsing.Flags.debug <- true), Some(InternalCommandLineOption("--debug-parse", rangeCmdArgs)), None) + CompilerOption("ilfiles", tagNone, OptionUnit (fun () -> tcConfigB.writeGeneratedILFiles <- true), Some(InternalCommandLineOption("--ilfiles", rangeCmdArgs)), None) #endif - CompilerOption("pause", tagNone, OptionUnit (fun () -> tcConfigB.pause <- true), Some(InternalCommandLineOption("--pause", rangeCmdArgs)), None); - CompilerOption("detuple", tagNone, OptionInt (setFlag (fun v -> tcConfigB.doDetuple <- v)), Some(InternalCommandLineOption("--detuple", rangeCmdArgs)), None); - CompilerOption("simulateException", tagNone, OptionString (fun s -> tcConfigB.simulateException <- Some(s)), Some(InternalCommandLineOption("--simulateException", rangeCmdArgs)), Some "Simulate an exception from some part of the compiler"); - CompilerOption("stackReserveSize", tagNone, OptionString (fun s -> tcConfigB.stackReserveSize <- Some(int32 s)), Some(InternalCommandLineOption("--stackReserveSize", rangeCmdArgs)), Some ("for an exe, set stack reserve size")); - CompilerOption("tlr", tagInt, OptionInt (setFlag (fun v -> tcConfigB.doTLR <- v)), Some(InternalCommandLineOption("--tlr", rangeCmdArgs)), None); - CompilerOption("finalSimplify", tagInt, OptionInt (setFlag (fun v -> tcConfigB.doFinalSimplify <- v)), Some(InternalCommandLineOption("--finalSimplify", rangeCmdArgs)), None); + CompilerOption("pause", tagNone, OptionUnit (fun () -> tcConfigB.pause <- true), Some(InternalCommandLineOption("--pause", rangeCmdArgs)), None) + CompilerOption("detuple", tagNone, OptionInt (setFlag (fun v -> tcConfigB.doDetuple <- v)), Some(InternalCommandLineOption("--detuple", rangeCmdArgs)), None) + CompilerOption("simulateException", tagNone, OptionString (fun s -> tcConfigB.simulateException <- Some(s)), Some(InternalCommandLineOption("--simulateException", rangeCmdArgs)), Some "Simulate an exception from some part of the compiler") + CompilerOption("stackReserveSize", tagNone, OptionString (fun s -> tcConfigB.stackReserveSize <- Some(int32 s)), Some(InternalCommandLineOption("--stackReserveSize", rangeCmdArgs)), Some ("for an exe, set stack reserve size")) + CompilerOption("tlr", tagInt, OptionInt (setFlag (fun v -> tcConfigB.doTLR <- v)), Some(InternalCommandLineOption("--tlr", rangeCmdArgs)), None) + CompilerOption("finalSimplify", tagInt, OptionInt (setFlag (fun v -> tcConfigB.doFinalSimplify <- v)), Some(InternalCommandLineOption("--finalSimplify", rangeCmdArgs)), None) #if TLR_LIFT - CompilerOption("tlrlift", tagNone, OptionInt (setFlag (fun v -> InnerLambdasToTopLevelFuncs.liftTLR := v)), Some(InternalCommandLineOption("--tlrlift", rangeCmdArgs)), None); + CompilerOption("tlrlift", tagNone, OptionInt (setFlag (fun v -> InnerLambdasToTopLevelFuncs.liftTLR := v)), Some(InternalCommandLineOption("--tlrlift", rangeCmdArgs)), None) #endif - CompilerOption("parseonly", tagNone, OptionUnit (fun () -> tcConfigB.parseOnly <- true), Some(InternalCommandLineOption("--parseonly", rangeCmdArgs)), None); - CompilerOption("typecheckonly", tagNone, OptionUnit (fun () -> tcConfigB.typeCheckOnly <- true), Some(InternalCommandLineOption("--typecheckonly", rangeCmdArgs)), None); - CompilerOption("ast", tagNone, OptionUnit (fun () -> tcConfigB.printAst <- true), Some(InternalCommandLineOption("--ast", rangeCmdArgs)), None); - CompilerOption("tokenize", tagNone, OptionUnit (fun () -> tcConfigB.tokenizeOnly <- true), Some(InternalCommandLineOption("--tokenize", rangeCmdArgs)), None); - CompilerOption("testInteractionParser", tagNone, OptionUnit (fun () -> tcConfigB.testInteractionParser <- true), Some(InternalCommandLineOption("--testInteractionParser", rangeCmdArgs)), None); - CompilerOption("testparsererrorrecovery", tagNone, OptionUnit (fun () -> tcConfigB.reportNumDecls <- true), Some(InternalCommandLineOption("--testparsererrorrecovery", rangeCmdArgs)), None); - CompilerOption("inlinethreshold", tagInt, OptionInt (fun n -> tcConfigB.optSettings <- { tcConfigB.optSettings with lambdaInlineThreshold = n }), Some(InternalCommandLineOption("--inlinethreshold", rangeCmdArgs)), None); - CompilerOption("extraoptimizationloops", tagNone, OptionInt (fun n -> tcConfigB.extraOptimizationIterations <- n), Some(InternalCommandLineOption("--extraoptimizationloops", rangeCmdArgs)), None); - CompilerOption("abortonerror", tagNone, OptionUnit (fun () -> tcConfigB.abortOnError <- true), Some(InternalCommandLineOption("--abortonerror", rangeCmdArgs)), None); - CompilerOption("implicitresolution", tagNone, OptionUnit (fun _ -> tcConfigB.implicitlyResolveAssemblies <- true), Some(InternalCommandLineOption("--implicitresolution", rangeCmdArgs)), None); - - CompilerOption("resolutions", tagNone, OptionUnit (fun () -> tcConfigB.showReferenceResolutions <- true), Some(InternalCommandLineOption("", rangeCmdArgs)), None); // "Display assembly reference resolution information") ; - CompilerOption("resolutionframeworkregistrybase", tagString, OptionString (fun s -> tcConfigB.resolutionFrameworkRegistryBase<-s), Some(InternalCommandLineOption("", rangeCmdArgs)), None); // "The base registry key to use for assembly resolution. This part in brackets here: HKEY_LOCAL_MACHINE\[SOFTWARE\Microsoft\.NETFramework]\v2.0.50727\AssemblyFoldersEx"); - CompilerOption("resolutionassemblyfoldersuffix", tagString, OptionString (fun s -> tcConfigB.resolutionAssemblyFoldersSuffix<-s), Some(InternalCommandLineOption("resolutionassemblyfoldersuffix", rangeCmdArgs)), None); // "The base registry key to use for assembly resolution. This part in brackets here: HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\.NETFramework\v2.0.50727\[AssemblyFoldersEx]"); - CompilerOption("resolutionassemblyfoldersconditions", tagString, OptionString (fun s -> tcConfigB.resolutionAssemblyFoldersConditions <- ","^s), Some(InternalCommandLineOption("resolutionassemblyfoldersconditions", rangeCmdArgs)), None); // "Additional reference resolution conditions. For example \"OSVersion=5.1.2600.0,PlatformID=id"); - CompilerOption("msbuildresolution", tagNone, OptionUnit (fun () -> tcConfigB.useMonoResolution<-false), Some(InternalCommandLineOption("msbuildresolution", rangeCmdArgs)), None); // "Resolve assembly references using MSBuild resolution rules rather than directory based (Default=true except when running fsc.exe under mono)"); - CompilerOption("alwayscallvirt",tagNone,OptionSwitch(callVirtSwitch tcConfigB),Some(InternalCommandLineOption("alwayscallvirt",rangeCmdArgs)), None); - CompilerOption("nodebugdata",tagNone, OptionUnit (fun () -> tcConfigB.noDebugData<-true),Some(InternalCommandLineOption("--nodebugdata",rangeCmdArgs)), None); + CompilerOption("parseonly", tagNone, OptionUnit (fun () -> tcConfigB.parseOnly <- true), Some(InternalCommandLineOption("--parseonly", rangeCmdArgs)), None) + CompilerOption("typecheckonly", tagNone, OptionUnit (fun () -> tcConfigB.typeCheckOnly <- true), Some(InternalCommandLineOption("--typecheckonly", rangeCmdArgs)), None) + CompilerOption("ast", tagNone, OptionUnit (fun () -> tcConfigB.printAst <- true), Some(InternalCommandLineOption("--ast", rangeCmdArgs)), None) + CompilerOption("tokenize", tagNone, OptionUnit (fun () -> tcConfigB.tokenizeOnly <- true), Some(InternalCommandLineOption("--tokenize", rangeCmdArgs)), None) + CompilerOption("testInteractionParser", tagNone, OptionUnit (fun () -> tcConfigB.testInteractionParser <- true), Some(InternalCommandLineOption("--testInteractionParser", rangeCmdArgs)), None) + CompilerOption("testparsererrorrecovery", tagNone, OptionUnit (fun () -> tcConfigB.reportNumDecls <- true), Some(InternalCommandLineOption("--testparsererrorrecovery", rangeCmdArgs)), None) + CompilerOption("inlinethreshold", tagInt, OptionInt (fun n -> tcConfigB.optSettings <- { tcConfigB.optSettings with lambdaInlineThreshold = n }), Some(InternalCommandLineOption("--inlinethreshold", rangeCmdArgs)), None) + CompilerOption("extraoptimizationloops", tagNone, OptionInt (fun n -> tcConfigB.extraOptimizationIterations <- n), Some(InternalCommandLineOption("--extraoptimizationloops", rangeCmdArgs)), None) + CompilerOption("abortonerror", tagNone, OptionUnit (fun () -> tcConfigB.abortOnError <- true), Some(InternalCommandLineOption("--abortonerror", rangeCmdArgs)), None) + CompilerOption("implicitresolution", tagNone, OptionUnit (fun _ -> tcConfigB.implicitlyResolveAssemblies <- true), Some(InternalCommandLineOption("--implicitresolution", rangeCmdArgs)), None) + + CompilerOption("resolutions", tagNone, OptionUnit (fun () -> tcConfigB.showReferenceResolutions <- true), Some(InternalCommandLineOption("", rangeCmdArgs)), None) // "Display assembly reference resolution information") + CompilerOption("resolutionframeworkregistrybase", tagString, OptionString (fun s -> tcConfigB.resolutionFrameworkRegistryBase<-s), Some(InternalCommandLineOption("", rangeCmdArgs)), None) // "The base registry key to use for assembly resolution. This part in brackets here: HKEY_LOCAL_MACHINE\[SOFTWARE\Microsoft\.NETFramework]\v2.0.50727\AssemblyFoldersEx") + CompilerOption("resolutionassemblyfoldersuffix", tagString, OptionString (fun s -> tcConfigB.resolutionAssemblyFoldersSuffix<-s), Some(InternalCommandLineOption("resolutionassemblyfoldersuffix", rangeCmdArgs)), None) // "The base registry key to use for assembly resolution. This part in brackets here: HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\.NETFramework\v2.0.50727\[AssemblyFoldersEx]") + CompilerOption("resolutionassemblyfoldersconditions", tagString, OptionString (fun s -> tcConfigB.resolutionAssemblyFoldersConditions <- ","^s), Some(InternalCommandLineOption("resolutionassemblyfoldersconditions", rangeCmdArgs)), None) // "Additional reference resolution conditions. For example \"OSVersion=5.1.2600.0,PlatformID=id") + CompilerOption("msbuildresolution", tagNone, OptionUnit (fun () -> tcConfigB.useSimpleResolution<-false), Some(InternalCommandLineOption("msbuildresolution", rangeCmdArgs)), None) // "Resolve assembly references using MSBuild resolution rules rather than directory based (Default=true except when running fsc.exe under mono)") + CompilerOption("alwayscallvirt",tagNone,OptionSwitch(callVirtSwitch tcConfigB),Some(InternalCommandLineOption("alwayscallvirt",rangeCmdArgs)), None) + CompilerOption("nodebugdata",tagNone, OptionUnit (fun () -> tcConfigB.noDebugData<-true),Some(InternalCommandLineOption("--nodebugdata",rangeCmdArgs)), None) testFlag tcConfigB ] @ vsSpecificFlags tcConfigB @ - [ CompilerOption("jit", tagNone, OptionSwitch (jitoptimizeSwitch tcConfigB), Some(InternalCommandLineOption("jit", rangeCmdArgs)), None); - CompilerOption("localoptimize", tagNone, OptionSwitch(localoptimizeSwitch tcConfigB),Some(InternalCommandLineOption("localoptimize", rangeCmdArgs)), None); - CompilerOption("splitting", tagNone, OptionSwitch(splittingSwitch tcConfigB),Some(InternalCommandLineOption("splitting", rangeCmdArgs)), None); - CompilerOption("versionfile", tagString, OptionString (fun s -> tcConfigB.version <- VersionFile s), Some(InternalCommandLineOption("versionfile", rangeCmdArgs)), None); - CompilerOption("times" , tagNone, OptionUnit (fun () -> tcConfigB.showTimes <- true), Some(InternalCommandLineOption("times", rangeCmdArgs)), None); // "Display timing profiles for compilation"); + [ CompilerOption("jit", tagNone, OptionSwitch (jitoptimizeSwitch tcConfigB), Some(InternalCommandLineOption("jit", rangeCmdArgs)), None) + CompilerOption("localoptimize", tagNone, OptionSwitch(localoptimizeSwitch tcConfigB),Some(InternalCommandLineOption("localoptimize", rangeCmdArgs)), None) + CompilerOption("splitting", tagNone, OptionSwitch(splittingSwitch tcConfigB),Some(InternalCommandLineOption("splitting", rangeCmdArgs)), None) + CompilerOption("versionfile", tagString, OptionString (fun s -> tcConfigB.version <- VersionFile s), Some(InternalCommandLineOption("versionfile", rangeCmdArgs)), None) + CompilerOption("times" , tagNone, OptionUnit (fun () -> tcConfigB.showTimes <- true), Some(InternalCommandLineOption("times", rangeCmdArgs)), None) // "Display timing profiles for compilation") #if EXTENSIONTYPING - CompilerOption("showextensionresolution" , tagNone, OptionUnit (fun () -> tcConfigB.showExtensionTypeMessages <- true), Some(InternalCommandLineOption("showextensionresolution", rangeCmdArgs)), None); // "Display information about extension type resolution"); + CompilerOption("showextensionresolution" , tagNone, OptionUnit (fun () -> tcConfigB.showExtensionTypeMessages <- true), Some(InternalCommandLineOption("showextensionresolution", rangeCmdArgs)), None) // "Display information about extension type resolution") #endif (* BEGIN: Consider as public Retail option? *) // Some System.Console do not have operational colors, make this available in Retail? - CompilerOption("metadataversion", tagString, OptionString (fun s -> tcConfigB.metadataVersion <- Some(s)), Some(InternalCommandLineOption("metadataversion", rangeCmdArgs)), None); + CompilerOption("metadataversion", tagString, OptionString (fun s -> tcConfigB.metadataVersion <- Some(s)), Some(InternalCommandLineOption("metadataversion", rangeCmdArgs)), None) ] @@ -882,14 +882,14 @@ let internalFlags (tcConfigB:TcConfigBuilder) = //-------------------------------------------------- let compilingFsLibFlag (tcConfigB : TcConfigBuilder) = - CompilerOption("compiling-fslib", tagNone, OptionUnit (fun () -> tcConfigB.compilingFslib <- true; - tcConfigB.TurnWarningOff(rangeStartup,"42"); - ErrorLogger.reportLibraryOnlyFeatures <- false; + CompilerOption("compiling-fslib", tagNone, OptionUnit (fun () -> tcConfigB.compilingFslib <- true + tcConfigB.TurnWarningOff(rangeStartup,"42") + ErrorLogger.reportLibraryOnlyFeatures <- false 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) + CompilerOption("compiling-fslib-20", tagNone, OptionString (fun s -> tcConfigB.compilingFslib20 <- Some s ), Some(InternalCommandLineOption("--compiling-fslib-20", rangeCmdArgs)), None) let compilingFsLib40Flag (tcConfigB : TcConfigBuilder) = - CompilerOption("compiling-fslib-40", tagNone, OptionUnit (fun () -> tcConfigB.compilingFslib40 <- true; ), Some(InternalCommandLineOption("--compiling-fslib-40", rangeCmdArgs)), None) + CompilerOption("compiling-fslib-40", tagNone, OptionUnit (fun () -> tcConfigB.compilingFslib40 <- true ), Some(InternalCommandLineOption("--compiling-fslib-40", rangeCmdArgs)), None) let mlKeywordsFlag = CompilerOption("ml-keywords", tagNone, OptionUnit (fun () -> ()), Some(DeprecatedCommandLineOptionNoDescription("--ml-keywords", rangeCmdArgs)), None) @@ -898,40 +898,40 @@ let gnuStyleErrorsFlag tcConfigB = let deprecatedFlagsBoth tcConfigB = [ - CompilerOption("light", tagNone, OptionUnit (fun () -> tcConfigB.light <- Some(true)), Some(DeprecatedCommandLineOptionNoDescription("--light", rangeCmdArgs)), None); - CompilerOption("indentation-syntax", tagNone, OptionUnit (fun () -> tcConfigB.light <- Some(true)), Some(DeprecatedCommandLineOptionNoDescription("--indentation-syntax", rangeCmdArgs)), None); - CompilerOption("no-indentation-syntax", tagNone, OptionUnit (fun () -> tcConfigB.light <- Some(false)), Some(DeprecatedCommandLineOptionNoDescription("--no-indentation-syntax", rangeCmdArgs)), None); + CompilerOption("light", tagNone, OptionUnit (fun () -> tcConfigB.light <- Some(true)), Some(DeprecatedCommandLineOptionNoDescription("--light", rangeCmdArgs)), None) + CompilerOption("indentation-syntax", tagNone, OptionUnit (fun () -> tcConfigB.light <- Some(true)), Some(DeprecatedCommandLineOptionNoDescription("--indentation-syntax", rangeCmdArgs)), None) + CompilerOption("no-indentation-syntax", tagNone, OptionUnit (fun () -> tcConfigB.light <- Some(false)), Some(DeprecatedCommandLineOptionNoDescription("--no-indentation-syntax", rangeCmdArgs)), None) ] let deprecatedFlagsFsi tcConfigB = deprecatedFlagsBoth tcConfigB let deprecatedFlagsFsc tcConfigB = deprecatedFlagsBoth tcConfigB @ [ - cliRootFlag tcConfigB; - CompilerOption("jit-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some true }), Some(DeprecatedCommandLineOptionNoDescription("--jit-optimize", rangeCmdArgs)), None); - CompilerOption("no-jit-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some false }), Some(DeprecatedCommandLineOptionNoDescription("--no-jit-optimize", rangeCmdArgs)), None); - CompilerOption("jit-tracking", tagNone, OptionUnit (fun _ -> () ), Some(DeprecatedCommandLineOptionNoDescription("--jit-tracking", rangeCmdArgs)), None); - CompilerOption("no-jit-tracking", tagNone, OptionUnit (fun _ -> () ), Some(DeprecatedCommandLineOptionNoDescription("--no-jit-tracking", rangeCmdArgs)), None); - CompilerOption("progress", tagNone, OptionUnit (fun () -> progress := true), Some(DeprecatedCommandLineOptionNoDescription("--progress", rangeCmdArgs)), None); - (compilingFsLibFlag tcConfigB) ; - (compilingFsLib20Flag tcConfigB) ; - (compilingFsLib40Flag tcConfigB) ; - CompilerOption("version", tagString, OptionString (fun s -> tcConfigB.version <- VersionString s), Some(DeprecatedCommandLineOptionNoDescription("--version", rangeCmdArgs)), None); -// "--clr-mscorlib", OptionString (fun s -> warning(Some(DeprecatedCommandLineOptionNoDescription("--clr-mscorlib", rangeCmdArgs))) ; tcConfigB.Build.mscorlib_assembly_name <- s), "\n\tThe name of mscorlib on the target CLR"; - CompilerOption("local-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some true }), Some(DeprecatedCommandLineOptionNoDescription("--local-optimize", rangeCmdArgs)), None); - CompilerOption("no-local-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some false }), Some(DeprecatedCommandLineOptionNoDescription("--no-local-optimize", rangeCmdArgs)), None); - CompilerOption("cross-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some true }), Some(DeprecatedCommandLineOptionNoDescription("--cross-optimize", rangeCmdArgs)), None); - CompilerOption("no-cross-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some false }), Some(DeprecatedCommandLineOptionNoDescription("--no-cross-optimize", rangeCmdArgs)), None); - CompilerOption("no-string-interning", tagNone, OptionUnit (fun () -> tcConfigB.internConstantStrings <- false), Some(DeprecatedCommandLineOptionNoDescription("--no-string-interning", rangeCmdArgs)), None); - CompilerOption("statistics", tagNone, OptionUnit (fun () -> tcConfigB.stats <- true), Some(DeprecatedCommandLineOptionNoDescription("--statistics", rangeCmdArgs)), None); - CompilerOption("generate-filter-blocks", tagNone, OptionUnit (fun () -> tcConfigB.generateFilterBlocks <- true), Some(DeprecatedCommandLineOptionNoDescription("--generate-filter-blocks", rangeCmdArgs)), None); - //CompilerOption("no-generate-filter-blocks", tagNone, OptionUnit (fun () -> tcConfigB.generateFilterBlocks <- false), Some(DeprecatedCommandLineOptionNoDescription("--generate-filter-blocks", rangeCmdArgs)), None); - CompilerOption("max-errors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), Some(DeprecatedCommandLineOptionSuggestAlternative("--max-errors", "--maxerrors", rangeCmdArgs)),None); - CompilerOption("debug-file", tagNone, OptionString (fun s -> tcConfigB.debugSymbolFile <- Some s), Some(DeprecatedCommandLineOptionSuggestAlternative("--debug-file", "--pdb", rangeCmdArgs)), None); - CompilerOption("no-debug-file", tagNone, OptionUnit (fun () -> tcConfigB.debuginfo <- false), Some(DeprecatedCommandLineOptionSuggestAlternative("--no-debug-file", "--debug-", rangeCmdArgs)), None); - CompilerOption("Ooff", tagNone, OptionUnit (fun () -> SetOptimizeOff(tcConfigB)), Some(DeprecatedCommandLineOptionSuggestAlternative("-Ooff", "--optimize-", rangeCmdArgs)), None); - mlKeywordsFlag ; - gnuStyleErrorsFlag tcConfigB; + cliRootFlag tcConfigB + CompilerOption("jit-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some true }), Some(DeprecatedCommandLineOptionNoDescription("--jit-optimize", rangeCmdArgs)), None) + CompilerOption("no-jit-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some false }), Some(DeprecatedCommandLineOptionNoDescription("--no-jit-optimize", rangeCmdArgs)), None) + CompilerOption("jit-tracking", tagNone, OptionUnit (fun _ -> () ), Some(DeprecatedCommandLineOptionNoDescription("--jit-tracking", rangeCmdArgs)), None) + CompilerOption("no-jit-tracking", tagNone, OptionUnit (fun _ -> () ), Some(DeprecatedCommandLineOptionNoDescription("--no-jit-tracking", rangeCmdArgs)), None) + CompilerOption("progress", tagNone, OptionUnit (fun () -> progress := true), Some(DeprecatedCommandLineOptionNoDescription("--progress", rangeCmdArgs)), None) + (compilingFsLibFlag tcConfigB) + (compilingFsLib20Flag tcConfigB) + (compilingFsLib40Flag tcConfigB) + CompilerOption("version", tagString, OptionString (fun s -> tcConfigB.version <- VersionString s), Some(DeprecatedCommandLineOptionNoDescription("--version", rangeCmdArgs)), None) +// "--clr-mscorlib", OptionString (fun s -> warning(Some(DeprecatedCommandLineOptionNoDescription("--clr-mscorlib", rangeCmdArgs))) tcConfigB.Build.mscorlib_assembly_name <- s), "\n\tThe name of mscorlib on the target CLR" + CompilerOption("local-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some true }), Some(DeprecatedCommandLineOptionNoDescription("--local-optimize", rangeCmdArgs)), None) + CompilerOption("no-local-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some false }), Some(DeprecatedCommandLineOptionNoDescription("--no-local-optimize", rangeCmdArgs)), None) + CompilerOption("cross-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some true }), Some(DeprecatedCommandLineOptionNoDescription("--cross-optimize", rangeCmdArgs)), None) + CompilerOption("no-cross-optimize", tagNone, OptionUnit (fun _ -> tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some false }), Some(DeprecatedCommandLineOptionNoDescription("--no-cross-optimize", rangeCmdArgs)), None) + CompilerOption("no-string-interning", tagNone, OptionUnit (fun () -> tcConfigB.internConstantStrings <- false), Some(DeprecatedCommandLineOptionNoDescription("--no-string-interning", rangeCmdArgs)), None) + CompilerOption("statistics", tagNone, OptionUnit (fun () -> tcConfigB.stats <- true), Some(DeprecatedCommandLineOptionNoDescription("--statistics", rangeCmdArgs)), None) + CompilerOption("generate-filter-blocks", tagNone, OptionUnit (fun () -> tcConfigB.generateFilterBlocks <- true), Some(DeprecatedCommandLineOptionNoDescription("--generate-filter-blocks", rangeCmdArgs)), None) + //CompilerOption("no-generate-filter-blocks", tagNone, OptionUnit (fun () -> tcConfigB.generateFilterBlocks <- false), Some(DeprecatedCommandLineOptionNoDescription("--generate-filter-blocks", rangeCmdArgs)), None) + CompilerOption("max-errors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), Some(DeprecatedCommandLineOptionSuggestAlternative("--max-errors", "--maxerrors", rangeCmdArgs)),None) + CompilerOption("debug-file", tagNone, OptionString (fun s -> tcConfigB.debugSymbolFile <- Some s), Some(DeprecatedCommandLineOptionSuggestAlternative("--debug-file", "--pdb", rangeCmdArgs)), None) + CompilerOption("no-debug-file", tagNone, OptionUnit (fun () -> tcConfigB.debuginfo <- false), Some(DeprecatedCommandLineOptionSuggestAlternative("--no-debug-file", "--debug-", rangeCmdArgs)), None) + CompilerOption("Ooff", tagNone, OptionUnit (fun () -> SetOptimizeOff(tcConfigB)), Some(DeprecatedCommandLineOptionSuggestAlternative("-Ooff", "--optimize-", rangeCmdArgs)), None) + mlKeywordsFlag + gnuStyleErrorsFlag tcConfigB ] @@ -946,17 +946,17 @@ let DisplayBannerText tcConfigB = /// FSC only help. (FSI has it's own help function). let displayHelpFsc tcConfigB (blocks:CompilerOptionBlock list) = - DisplayBannerText tcConfigB; + DisplayBannerText tcConfigB PrintCompilerOptionBlocks blocks exit 0 let miscFlagsBoth tcConfigB = - [ CompilerOption("nologo", tagNone, OptionUnit (fun () -> tcConfigB.showBanner <- false), None, Some (FSComp.SR.optsNologo())); + [ CompilerOption("nologo", tagNone, OptionUnit (fun () -> tcConfigB.showBanner <- false), None, Some (FSComp.SR.optsNologo())) ] let miscFlagsFsc tcConfigB = miscFlagsBoth tcConfigB @ - [ CompilerOption("help", tagNone, OptionHelp (fun blocks -> displayHelpFsc tcConfigB blocks), None, Some (FSComp.SR.optsHelp())); + [ CompilerOption("help", tagNone, OptionHelp (fun blocks -> displayHelpFsc tcConfigB blocks), None, Some (FSComp.SR.optsHelp())) CompilerOption("@", tagNone, OptionUnit ignore, None, Some (FSComp.SR.optsResponseFile())) ] let miscFlagsFsi tcConfigB = miscFlagsBoth tcConfigB @@ -967,23 +967,23 @@ let miscFlagsFsi tcConfigB = miscFlagsBoth tcConfigB let abbreviatedFlagsBoth tcConfigB = [ - CompilerOption("d", tagString, OptionString (defineSymbol tcConfigB), None, Some(FSComp.SR.optsShortFormOf("--define"))); - CompilerOption("O", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB) , None, Some(FSComp.SR.optsShortFormOf("--optimize[+|-]"))); - CompilerOption("g", tagNone, OptionSwitch (SetDebugSwitch tcConfigB None), None, Some(FSComp.SR.optsShortFormOf("--debug"))); - CompilerOption("i", tagString, OptionUnit (fun () -> tcConfigB.printSignature <- true), None, Some(FSComp.SR.optsShortFormOf("--sig"))); - referenceFlagAbbrev tcConfigB; (* -r *) - libFlagAbbrev tcConfigB; (* -I *) + CompilerOption("d", tagString, OptionString (defineSymbol tcConfigB), None, Some(FSComp.SR.optsShortFormOf("--define"))) + CompilerOption("O", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB) , None, Some(FSComp.SR.optsShortFormOf("--optimize[+|-]"))) + CompilerOption("g", tagNone, OptionSwitch (SetDebugSwitch tcConfigB None), None, Some(FSComp.SR.optsShortFormOf("--debug"))) + CompilerOption("i", tagString, OptionUnit (fun () -> tcConfigB.printSignature <- true), None, Some(FSComp.SR.optsShortFormOf("--sig"))) + referenceFlagAbbrev tcConfigB (* -r *) + libFlagAbbrev tcConfigB (* -I *) ] let abbreviatedFlagsFsi tcConfigB = abbreviatedFlagsBoth tcConfigB let abbreviatedFlagsFsc tcConfigB = abbreviatedFlagsBoth tcConfigB @ [ (* FSC only abbreviated options *) - CompilerOption("o", tagString, OptionString (setOutFileName tcConfigB), None, Some(FSComp.SR.optsShortFormOf("--out"))); - CompilerOption("a", tagString, OptionUnit (fun () -> tcConfigB.target <- Dll), None, Some(FSComp.SR.optsShortFormOf("--target library"))); + CompilerOption("o", tagString, OptionString (setOutFileName tcConfigB), None, Some(FSComp.SR.optsShortFormOf("--out"))) + CompilerOption("a", tagString, OptionUnit (fun () -> tcConfigB.target <- Dll), None, Some(FSComp.SR.optsShortFormOf("--target library"))) (* FSC help abbreviations. FSI has it's own help options... *) - CompilerOption("?" , tagNone, OptionHelp (fun blocks -> displayHelpFsc tcConfigB blocks), None, Some(FSComp.SR.optsShortFormOf("--help"))); - CompilerOption("help" , tagNone, OptionHelp (fun blocks -> displayHelpFsc tcConfigB blocks), None, Some(FSComp.SR.optsShortFormOf("--help"))); + CompilerOption("?" , tagNone, OptionHelp (fun blocks -> displayHelpFsc tcConfigB blocks), None, Some(FSComp.SR.optsShortFormOf("--help"))) + CompilerOption("help" , tagNone, OptionHelp (fun blocks -> displayHelpFsc tcConfigB blocks), None, Some(FSComp.SR.optsShortFormOf("--help"))) CompilerOption("full-help", tagNone, OptionHelp (fun blocks -> displayHelpFsc tcConfigB blocks), None, Some(FSComp.SR.optsShortFormOf("--help"))) ] @@ -1006,7 +1006,7 @@ let PostProcessCompilerArgs (abbrevArgs : string Set) (args : string []) = while i < len do if not(abbrevArgs.Contains(args.[i])) || i = (len - 1) then - arga.[idx] <- args.[i] ; + arga.[idx] <- args.[i] i <- i+1 else arga.[idx] <- args.[i] ^ ":" ^ args.[i+1] @@ -1057,17 +1057,17 @@ let testingAndQAFlags _tcConfigB = /// The core/common options used by fsc.exe. [not currently extended by fsc.fs]. let GetCoreFscCompilerOptions (tcConfigB: TcConfigBuilder) = - [ PublicOptions(FSComp.SR.optsHelpBannerOutputFiles(), outputFileFlagsFsc tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerInputFiles(), inputFileFlagsFsc tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerResources(), resourcesFlagsFsc tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerCodeGen(), codeGenerationFlags tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerErrsAndWarns(), errorsAndWarningsFlags tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerLanguage(), languageFlags tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerMisc(), miscFlagsFsc tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerAdvanced(), advancedFlagsFsc tcConfigB); - PrivateOptions(List.concat [ internalFlags tcConfigB; - abbreviatedFlagsFsc tcConfigB; - deprecatedFlagsFsc tcConfigB; + [ PublicOptions(FSComp.SR.optsHelpBannerOutputFiles(), outputFileFlagsFsc tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerInputFiles(), inputFileFlagsFsc tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerResources(), resourcesFlagsFsc tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerCodeGen(), codeGenerationFlags false tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerErrsAndWarns(), errorsAndWarningsFlags tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerLanguage(), languageFlags tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerMisc(), miscFlagsFsc tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerAdvanced(), advancedFlagsFsc tcConfigB) + PrivateOptions(List.concat [ internalFlags tcConfigB + abbreviatedFlagsFsc tcConfigB + deprecatedFlagsFsc tcConfigB testingAndQAFlags tcConfigB]) ] @@ -1079,18 +1079,18 @@ let GetCoreServiceCompilerOptions (tcConfigB:TcConfigBuilder) = /// The core/common options used by fsi.exe. [note, some additional options are added in fsi.fs]. let GetCoreFsiCompilerOptions (tcConfigB: TcConfigBuilder) = - [ PublicOptions(FSComp.SR.optsHelpBannerOutputFiles() , outputFileFlagsFsi tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerInputFiles() , inputFileFlagsFsi tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerResources() , resourcesFlagsFsi tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerCodeGen() , codeGenerationFlags tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerErrsAndWarns() , errorsAndWarningsFlags tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerLanguage() , languageFlags tcConfigB); + [ PublicOptions(FSComp.SR.optsHelpBannerOutputFiles() , outputFileFlagsFsi tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerInputFiles() , inputFileFlagsFsi tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerResources() , resourcesFlagsFsi tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerCodeGen() , codeGenerationFlags true tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerErrsAndWarns() , errorsAndWarningsFlags tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerLanguage() , languageFlags tcConfigB) // Note: no HTML block for fsi.exe - PublicOptions(FSComp.SR.optsHelpBannerMisc() , miscFlagsFsi tcConfigB); - PublicOptions(FSComp.SR.optsHelpBannerAdvanced() , advancedFlagsFsi tcConfigB); - PrivateOptions(List.concat [ internalFlags tcConfigB; - abbreviatedFlagsFsi tcConfigB; - deprecatedFlagsFsi tcConfigB; + PublicOptions(FSComp.SR.optsHelpBannerMisc() , miscFlagsFsi tcConfigB) + PublicOptions(FSComp.SR.optsHelpBannerAdvanced() , advancedFlagsFsi tcConfigB) + PrivateOptions(List.concat [ internalFlags tcConfigB + abbreviatedFlagsFsi tcConfigB + deprecatedFlagsFsi tcConfigB testingAndQAFlags tcConfigB]) ] @@ -1107,13 +1107,13 @@ let PrintWholeAssemblyImplementation (tcConfig:TcConfig) outfile header expr = if tcConfig.writeTermsToFiles then let filename = outfile ^ ".terms" let n = !showTermFileCount - showTermFileCount := n+1; + showTermFileCount := n+1 use f = System.IO.File.CreateText (filename ^ "-" ^ string n ^ "-" ^ header) - Layout.outL f (Layout.squashTo 192 (DebugPrint.assemblyL expr)); + Layout.outL f (Layout.squashTo 192 (DebugPrint.assemblyL expr)) else - dprintf "\n------------------\nshowTerm: %s:\n" header; - Layout.outL stderr (Layout.squashTo 192 (DebugPrint.assemblyL expr)); - dprintf "\n------------------\n"; + dprintf "\n------------------\nshowTerm: %s:\n" header + Layout.outL stderr (Layout.squashTo 192 (DebugPrint.assemblyL expr)) + dprintf "\n------------------\n" //---------------------------------------------------------------------------- // ReportTime @@ -1127,8 +1127,8 @@ let ReportTime (tcConfig:TcConfig) descr = | None -> () | Some prevDescr -> if tcConfig.pause then - dprintf "[done '%s', entering '%s'] press to continue... " prevDescr descr; - System.Console.ReadLine() |> ignore; + dprintf "[done '%s', entering '%s'] press to continue... " prevDescr descr + System.Console.ReadLine() |> ignore // Intentionally putting this right after the pause so a debugger can be attached. match tcConfig.simulateException with | Some("fsc-oom") -> raise(System.OutOfMemoryException()) @@ -1175,7 +1175,7 @@ let ReportTime (tcConfig:TcConfig) descr = let spanGC = [| for i in 0 .. maxGen -> System.GC.CollectionCount(i) - gcPrev.[i] |] dprintf "TIME: %4.1f Delta: %4.1f Mem: %3d" timeNow (timeNow - timePrev) - wsNow; + wsNow dprintf " G0: %3d G1: %2d G2: %2d [%s]\n" spanGC.[Operators.min 0 maxGen] spanGC.[Operators.min 1 maxGen] spanGC.[Operators.min 2 maxGen] prevDescr @@ -1212,15 +1212,15 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM // Always optimize once - the results of this step give the x-module optimization // info. Subsequent optimization steps choose representations etc. which we don't // want to save in the x-module info (i.e. x-module info is currently "high level"). - PrintWholeAssemblyImplementation tcConfig outfile "pass-start" tassembly; + PrintWholeAssemblyImplementation tcConfig outfile "pass-start" tassembly #if DEBUG - if tcConfig.showOptimizationData then dprintf "Expression prior to optimization:\n%s\n" (Layout.showL (Layout.squashTo 192 (DebugPrint.assemblyL tassembly))); - if tcConfig.showOptimizationData then dprintf "CCU prior to optimization:\n%s\n" (Layout.showL (Layout.squashTo 192 (DebugPrint.entityL ccu.Contents))); + if tcConfig.showOptimizationData then dprintf "Expression prior to optimization:\n%s\n" (Layout.showL (Layout.squashTo 192 (DebugPrint.assemblyL tassembly))) + if tcConfig.showOptimizationData then dprintf "CCU prior to optimization:\n%s\n" (Layout.showL (Layout.squashTo 192 (DebugPrint.entityL ccu.Contents))) #endif let optEnv0 = optEnv let (TAssembly(implFiles)) = tassembly - ReportTime tcConfig ("Optimizations"); + ReportTime tcConfig ("Optimizations") let results,(optEnvFirstLoop,_,_,_) = ((optEnv0,optEnv0,optEnv0,SignatureHidingInfo.Empty),implFiles) ||> List.mapFold (fun (optEnvFirstLoop,optEnvExtraLoop,optEnvFinalSimplify,hidden) implFile -> @@ -1229,7 +1229,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM let optSettings = { optSettings with abstractBigTargets = tcConfig.doTLR } let optSettings = { optSettings with reportingPhase = true } - //ReportTime tcConfig ("Initial simplify"); + //ReportTime tcConfig ("Initial simplify") let optEnvFirstLoop,implFile,implFileOptData,hidden = Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFirstLoop,isIncrementalFragment,tcConfig.emitTailcalls,hidden,implFile) @@ -1239,23 +1239,23 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM let optSettings = { optSettings with abstractBigTargets = false } let optSettings = { optSettings with reportingPhase = false } #if DEBUG - if tcConfig.showOptimizationData then dprintf "Optimization implFileOptData:\n%s\n" (Layout.showL (Layout.squashTo 192 (Optimizer.moduleInfoL tcGlobals implFileOptData))); + if tcConfig.showOptimizationData then dprintf "Optimization implFileOptData:\n%s\n" (Layout.showL (Layout.squashTo 192 (Optimizer.moduleInfoL tcGlobals implFileOptData))) #endif let implFile,optEnvExtraLoop = if tcConfig.extraOptimizationIterations > 0 then - //ReportTime tcConfig ("Extra simplification loop"); + //ReportTime tcConfig ("Extra simplification loop") let optEnvExtraLoop,implFile, _, _ = Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvExtraLoop,isIncrementalFragment,tcConfig.emitTailcalls,hidden,implFile) - //PrintWholeAssemblyImplementation tcConfig outfile (sprintf "extra-loop-%d" n) implFile; + //PrintWholeAssemblyImplementation tcConfig outfile (sprintf "extra-loop-%d" n) implFile implFile,optEnvExtraLoop else implFile,optEnvExtraLoop let implFile = if tcConfig.doDetuple then - //ReportTime tcConfig ("Detupled optimization"); + //ReportTime tcConfig ("Detupled optimization") let implFile = implFile |> Detuple.DetupleImplFile ccu tcGlobals - //PrintWholeAssemblyImplementation tcConfig outfile "post-detuple" implFile; + //PrintWholeAssemblyImplementation tcConfig outfile "post-detuple" implFile implFile else implFile @@ -1269,9 +1269,9 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM let implFile,optEnvFinalSimplify = if tcConfig.doFinalSimplify then - //ReportTime tcConfig ("Final simplify pass"); + //ReportTime tcConfig ("Final simplify pass") let optEnvFinalSimplify,implFile, _, _ = Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFinalSimplify,isIncrementalFragment,tcConfig.emitTailcalls,hidden,implFile) - //PrintWholeAssemblyImplementation tcConfig outfile "post-rec-opt" implFile; + //PrintWholeAssemblyImplementation tcConfig outfile "post-rec-opt" implFile implFile,optEnvFinalSimplify else implFile,optEnvFinalSimplify @@ -1280,8 +1280,8 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM let implFiles,implFileOptDatas = List.unzip results let assemblyOptData = Optimizer.UnionOptimizationInfos implFileOptDatas let tassembly = TAssembly(implFiles) - PrintWholeAssemblyImplementation tcConfig outfile "pass-end" tassembly; - ReportTime tcConfig ("Ending Optimizations"); + PrintWholeAssemblyImplementation tcConfig outfile "pass-end" tassembly + ReportTime tcConfig ("Ending Optimizations") tassembly, assemblyOptData,optEnvFirstLoop @@ -1297,20 +1297,20 @@ let CreateIlxAssemblyGenerator (_tcConfig:TcConfig,tcImports:TcImports,tcGlobals ilxGenerator let GenerateIlxCode (ilxBackend, isInteractiveItExpr, isInteractiveOnMono, tcConfig:TcConfig, topAttrs, optimizedImpls, fragName, netFxHasSerializableAttribute, ilxGenerator : IlxAssemblyGenerator) = - if !progress then dprintf "Generating ILX code...\n"; + if !progress then dprintf "Generating ILX code...\n" let ilxGenOpts : IlxGenOptions = - { generateFilterBlocks = tcConfig.generateFilterBlocks; - emitConstantArraysUsingStaticDataBlobs = not isInteractiveOnMono; - workAroundReflectionEmitBugs=tcConfig.isInteractive; // REVIEW: is this still required? - generateDebugSymbols= tcConfig.debuginfo; - fragName = fragName; - localOptimizationsAreOn= tcConfig.optSettings.localOpt (); - testFlagEmitFeeFeeAs100001 = tcConfig.testFlagEmitFeeFeeAs100001; - mainMethodInfo= (if (tcConfig.target = Dll || tcConfig.target = Module) then None else Some topAttrs.mainMethodAttrs); - ilxBackend = ilxBackend; - isInteractive = tcConfig.isInteractive; - isInteractiveItExpr = isInteractiveItExpr; - netFxHasSerializableAttribute = netFxHasSerializableAttribute; + { generateFilterBlocks = tcConfig.generateFilterBlocks + emitConstantArraysUsingStaticDataBlobs = not isInteractiveOnMono + workAroundReflectionEmitBugs=tcConfig.isInteractive // REVIEW: is this still required? + generateDebugSymbols= tcConfig.debuginfo + fragName = fragName + localOptimizationsAreOn= tcConfig.optSettings.localOpt () + testFlagEmitFeeFeeAs100001 = tcConfig.testFlagEmitFeeFeeAs100001 + mainMethodInfo= (if (tcConfig.target = Dll || tcConfig.target = Module) then None else Some topAttrs.mainMethodAttrs) + ilxBackend = ilxBackend + isInteractive = tcConfig.isInteractive + isInteractiveItExpr = isInteractiveItExpr + netFxHasSerializableAttribute = netFxHasSerializableAttribute alwaysCallVirt = tcConfig.alwaysCallVirt } ilxGenerator.GenerateCode (ilxGenOpts, optimizedImpls, topAttrs.assemblyAttrs,topAttrs.netModuleAttrs) @@ -1355,7 +1355,7 @@ let DoWithErrorColor isWarn f = try let warnColor = if Console.BackgroundColor = ConsoleColor.White then ConsoleColor.DarkBlue else ConsoleColor.Cyan let errorColor = ConsoleColor.Red - ignoreFailureOnMono1_1_16 (fun () -> Console.ForegroundColor <- (if isWarn then warnColor else errorColor)); - f(); + ignoreFailureOnMono1_1_16 (fun () -> Console.ForegroundColor <- (if isWarn then warnColor else errorColor)) + f() finally ignoreFailureOnMono1_1_16 (fun () -> Console.ForegroundColor <- c) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index fbab553659d..d8bef1dc1a0 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -160,31 +160,32 @@ type TcValF = (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) type ConstraintSolverState = { - g: TcGlobals; - amap: Import.ImportMap; - InfoReader : InfoReader; + g: TcGlobals + amap: Import.ImportMap + InfoReader : InfoReader TcVal : TcValF /// This table stores all unsolved, ungeneralized trait constraints, indexed by free type variable. /// That is, there will be one entry in this table for each free type variable in /// each outstanding, unsolved, ungeneralized trait constraint. Constraints are removed from the table and resolved /// each time a solution to an index variable is found. - mutable ExtraCxs: HashMultiMap; + mutable ExtraCxs: HashMultiMap } static member New(g,amap,infoReader, tcVal) = - { g=g; amap=amap; + { g=g + amap=amap ExtraCxs= HashMultiMap(10, HashIdentity.Structural) InfoReader=infoReader - TcVal = tcVal } ; + TcVal = tcVal } type ConstraintSolverEnv = { - SolverState: ConstraintSolverState; + SolverState: ConstraintSolverState eContextInfo: ContextInfo MatchingOnly : bool - m: range; - EquivEnv: TypeEquivEnv; + m: range + EquivEnv: TypeEquivEnv DisplayEnv : DisplayEnv } member csenv.InfoReader = csenv.SolverState.InfoReader @@ -192,12 +193,12 @@ type ConstraintSolverEnv = member csenv.amap = csenv.SolverState.amap let MakeConstraintSolverEnv contextInfo css m denv = - { SolverState=css; - m=m; + { SolverState=css + m=m eContextInfo = contextInfo // Indicates that when unifiying ty1 = ty2, only type variables in ty1 may be solved - MatchingOnly=false; - EquivEnv=TypeEquivEnv.Empty; + MatchingOnly=false + EquivEnv=TypeEquivEnv.Empty DisplayEnv = denv } @@ -303,9 +304,10 @@ let BakedInTraitConstraintNames = // Run the constraint solver with undo (used during method overload resolution) type Trace = - | Trace of (unit -> unit) list ref - static member New () = Trace (ref []) - member t.Undo () = let (Trace trace) = t in List.iter (fun a -> a ()) !trace + { mutable actions: (unit -> unit) list } + static member New () = { actions = [] } + member t.Undo () = List.iter (fun a -> a ()) t.actions + member t.Push f = t.actions <- f :: t.actions type OptionalTrace = | NoTrace @@ -417,7 +419,7 @@ let rec TransactStaticReq (csenv:ConstraintSolverEnv) trace (tpr:Typar) req = let orig = tpr.StaticReq match trace with | NoTrace -> () - | WithTrace (Trace actions) -> actions := (fun () -> tpr.SetStaticReq orig) :: !actions + | WithTrace trace -> trace.Push (fun () -> tpr.SetStaticReq orig) tpr.SetStaticReq req; CompleteD @@ -446,7 +448,7 @@ let rec TransactDynamicReq trace (tpr:Typar) req = let orig = tpr.DynamicReq match trace with | NoTrace -> () - | WithTrace (Trace actions) -> actions := (fun () -> tpr.SetDynamicReq orig) :: !actions + | WithTrace trace -> trace.Push (fun () -> tpr.SetDynamicReq orig) tpr.SetDynamicReq req; CompleteD @@ -673,7 +675,7 @@ let rec SolveTyparEqualsTyp (csenv:ConstraintSolverEnv) ndeep m2 trace ty1 ty = let tpdata = r.Data match trace with | NoTrace -> () - | WithTrace (Trace actions) -> actions := (fun () -> tpdata.typar_solution <- None) :: !actions + | WithTrace trace -> trace.Push (fun () -> tpdata.typar_solution <- None) tpdata.typar_solution <- Some ty; (* dprintf "setting typar %d to type %s at %a\n" r.Stamp ((DebugPrint.showType ty)) outputRange m; *) @@ -1343,7 +1345,7 @@ and TransactMemberConstraintSolution traitInfo trace sln = traitInfo.Solution <- Some sln match trace with | NoTrace -> () - | WithTrace (Trace actions) -> actions := (fun () -> traitInfo.Solution <- prev) :: !actions + | WithTrace trace -> trace.Push (fun () -> traitInfo.Solution <- prev) /// Only consider overload resolution if canonicalizing or all the types are now nominal. /// That is, don't perform resolution if more nominal information may influence the set of available overloads @@ -1410,7 +1412,7 @@ and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep per match trace with | NoTrace -> () - | WithTrace (Trace actions) -> actions := (fun () -> cxs |> List.iter (fun cx -> cxst.Add(tpn,cx))) :: !actions + | WithTrace trace -> trace.Push (fun () -> cxs |> List.iter (fun cx -> cxst.Add(tpn,cx))) cxs |> AtLeastOneD (fun (traitInfo,m2) -> let csenv = { csenv with m = m2 } @@ -1437,7 +1439,7 @@ and AddMemberConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace traitInfo sup if not (cxs |> List.exists (fun (traitInfo2,_) -> traitsAEquiv g aenv traitInfo traitInfo2)) then match trace with | NoTrace -> () - | WithTrace (Trace actions) -> actions := (fun () -> csenv.SolverState.ExtraCxs.Remove tpn) :: !actions + | WithTrace trace -> trace.Push (fun () -> csenv.SolverState.ExtraCxs.Remove tpn) csenv.SolverState.ExtraCxs.Add (tpn,(traitInfo,m2)) ); @@ -1611,11 +1613,10 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint = // Record a entry in the undo trace if one is provided let d = tp.Data let orig = d.typar_constraints - begin match trace with + match trace with | NoTrace -> () - | WithTrace (Trace actions) -> actions := (fun () -> d.typar_constraints <- orig) :: !actions - end; - d.typar_constraints <- newConstraints; + | WithTrace trace -> trace.Push (fun () -> d.typar_constraints <- orig) + d.typar_constraints <- newConstraints CompleteD))) @@ -1872,7 +1873,7 @@ and CanMemberSigsMatchUpToCheck if isArray1DTy g calledArg.CalledArgumentType then let paramArrayElemTy = destArrayTy g calledArg.CalledArgumentType let reflArgInfo = calledArg.ReflArgInfo // propgate the reflected-arg info to each param array argument - calledMeth.ParamArrayCallerArgs |> OptionD (IterateD (fun callerArg -> subsumeArg (CalledArg((0,0),false,NotOptional,false,None,reflArgInfo,paramArrayElemTy)) callerArg)) + calledMeth.ParamArrayCallerArgs |> OptionD (IterateD (fun callerArg -> subsumeArg (CalledArg((0,0),false,NotOptional,NoCallerInfo,false,None,reflArgInfo,paramArrayElemTy)) callerArg)) else CompleteD) @@ -1895,7 +1896,7 @@ and CanMemberSigsMatchUpToCheck let calledArgTy = rfinfo.FieldType rfinfo.Name, calledArgTy - subsumeArg (CalledArg((-1, 0), false, NotOptional, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller) )) ++ (fun () -> + subsumeArg (CalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller) )) ++ (fun () -> // - Always take the return type into account for // -- op_Explicit, op_Implicit @@ -1922,11 +1923,6 @@ and CanMemberSigsMatchUpToCheck //------------------------------------------------------------------------- -and private DefinitelyEquiv (csenv:ConstraintSolverEnv) isConstraint calledArg (CallerArg(callerArgTy,m,_,_) as callerArg) = - let calledArgTy = AdjustCalledArgType csenv.InfoReader isConstraint calledArg callerArg - if not (typeEquiv csenv.g calledArgTy callerArgTy) then ErrorD(Error(FSComp.SR.csArgumentTypesDoNotMatch(),m)) else - CompleteD - // Assert a subtype constraint, and wrap an ErrorsFromAddingSubsumptionConstraint error around any failure // to allow us to report the outer types involved in the constraint and private SolveTypSubsumesTypWithReport (csenv:ConstraintSolverEnv) ndeep m trace ty1 ty2 = @@ -2406,10 +2402,10 @@ let EliminateConstraintsForGeneralizedTypars csenv trace (generalizedTypars: Typ let cxs = cxst.FindAll tpn if isNil cxs then () else cxs |> List.iter (fun cx -> - cxst.Remove tpn; + cxst.Remove tpn match trace with | NoTrace -> () - | WithTrace (Trace actions) -> actions := (fun () -> (csenv.SolverState.ExtraCxs.Add (tpn,cx))) :: !actions) + | WithTrace trace -> trace.Push (fun () -> (csenv.SolverState.ExtraCxs.Add (tpn,cx)))) ) @@ -2575,11 +2571,21 @@ let CodegenWitnessThatTypSupportsTraitConstraint tcVal g amap m (traitInfo:Trait | true, true, 1 -> Some (mkStaticRecdFieldSet (rfref, tinst, argExprs.[0], m)) | true, false, 2 -> - Some (mkRecdFieldSet g (argExprs.[0], rfref, tinst, argExprs.[1], m)) + // If we resolve to an instance field on a struct and we haven't yet taken + // the address of the object then go do that + if rfref.Tycon.IsStructOrEnumTycon && not (isByrefTy g (tyOfExpr g argExprs.[0])) then + let h = List.head argExprs + let wrap,h' = mkExprAddrOfExpr g true false DefinitelyMutates h None m + Some (wrap (mkRecdFieldSetViaExprAddr (h', rfref, tinst, argExprs.[1], m))) + else + Some (mkRecdFieldSetViaExprAddr (argExprs.[0], rfref, tinst, argExprs.[1], m)) | false, true, 0 -> Some (mkStaticRecdFieldGet (rfref, tinst, m)) | false, false, 1 -> - Some (mkRecdFieldGet g (argExprs.[0], rfref, tinst, m)) + if rfref.Tycon.IsStructOrEnumTycon && isByrefTy g (tyOfExpr g argExprs.[0]) then + Some (mkRecdFieldGetViaExprAddr (argExprs.[0], rfref, tinst, m)) + else + Some (mkRecdFieldGet g (argExprs.[0], rfref, tinst, m)) | _ -> None ResultD res | Choice3Of4 expr -> ResultD (Some (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m))) diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index 63238ec1c49..3c71ffe57ee 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -98,7 +98,8 @@ val BakedInTraitConstraintNames : string list val MakeConstraintSolverEnv : ContextInfo -> ConstraintSolverState -> range -> DisplayEnv -> ConstraintSolverEnv -type Trace = Trace of (unit -> unit) list ref +[] +type Trace type OptionalTrace = | NoTrace diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index 640459eb3a0..1da56444ed3 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -227,13 +227,13 @@ module GlobalUsageAnalysis = let logNonRecBinding z (bind:Binding) = let v = bind.Var let vs = FlatList.one v - {z with RecursiveBindings = Zmap.add v (false,vs) z.RecursiveBindings; + {z with RecursiveBindings = Zmap.add v (false,vs) z.RecursiveBindings Defns = Zmap.add v bind.Expr z.Defns } /// Log the definition of a recursive binding let logRecBindings z binds = let vs = valsOfBinds binds - {z with RecursiveBindings = (z.RecursiveBindings,vs) ||> FlatList.fold (fun mubinds v -> Zmap.add v (true,vs) mubinds); + {z with RecursiveBindings = (z.RecursiveBindings,vs) ||> FlatList.fold (fun mubinds v -> Zmap.add v (true,vs) mubinds) Defns = (z.Defns,binds) ||> FlatList.fold (fun eqns bind -> Zmap.add bind.Var bind.Expr eqns) } /// Work locally under a lambda of some kind @@ -392,7 +392,7 @@ let rebuildTS g m ts vs = (x,ty),vs let (x,_ty),vs = rebuild vs ts - if vs.Length <> 0 then internalError "rebuildTS: had more fringe vars than fringe. REPORT BUG" else (); + if vs.Length <> 0 then internalError "rebuildTS: had more fringe vars than fringe. REPORT BUG" x /// CallPattern is tuple-structure for each argument position. @@ -794,7 +794,7 @@ let passBind penv (TBind(fOrig,repr,letSeqPtOpt) as bind) = // fCBody - parts - formals let transformedFormals = trans.transformedFormals let p = transformedFormals.Length - if (vss.Length < p) then internalError "passBinds: |vss|

[,[,public|private]]" optsDebugPM,"Emit debug information (Short form: -g)" -optsDebug,"Specify debugging type: full, portable, pdbonly. ('full' is the default and enables attaching a debugger to a running program. 'portable' is a cross-platform format)." +optsDebug,"Specify debugging type: full, portable, pdbonly. ('%s' is the default if no debuggging type specified and enables attaching a debugger to a running program. 'portable' is a cross-platform format)." optsOptimize,"Enable optimizations (Short form: -O)" optsTailcalls,"Enable or disable tailcalls" optsCrossoptimize,"Enable or disable cross-module optimizations" @@ -985,7 +986,7 @@ lexUnexpectedChar,"Unexpected character '%s'" 1153,lexInvalidFloat,"Invalid floating point number" 1154,lexOusideDecimal,"This number is outside the allowable range for decimal literals" 1155,lexOusideThirtyTwoBitFloat,"This number is outside the allowable range for 32-bit floats" -1156,lexInvalidNumericLiteral,"This is not a valid numeric literal. Valid numeric literals include 1, 0x1, 0b0001 (int), 1u (uint32), 1L (int64), 1UL (uint64), 1s (int16), 1y (sbyte), 1ui (byte), 1.0 (float), 1.0f (float32), 1.0m (decimal), 1I (BigInteger)." +1156,lexInvalidNumericLiteral,"This is not a valid numeric literal. Valid numeric literals include 1, 0x1, 0b0001 (int), 1u (uint32), 1L (int64), 1UL (uint64), 1s (int16), 1y (sbyte), 1uy (byte), 1.0 (float), 1.0f (float32), 1.0m (decimal), 1I (BigInteger)." 1157,lexInvalidByteLiteral,"This is not a valid byte literal" 1158,lexInvalidCharLiteral,"This is not a valid character literal" 1159,lexThisUnicodeOnlyInStringLiterals,"This Unicode encoding is only valid in string literals" @@ -1076,6 +1077,8 @@ lexIndentOffForML,"Consider using a file with extension '.ml' or '.mli' instead" 1243,parsUnexpectedQuotationOperatorInTypeAliasDidYouMeanVerbatimString,"Unexpected quotation operator '<@' in type definition. If you intend to pass a verbatim string as a static argument to a type provider, put a space between the '<' and '@' characters." 1244,parsErrorParsingAsOperatorName,"Attempted to parse this as an operator name, but failed" 1245,lexInvalidUnicodeLiteral,"\U%s is not a valid Unicode character escape sequence" +1246,tcCallerInfoWrongType,"'%s' must be applied to an argument of type '%s', but has been applied to an argument of type '%s'" +1247,tcCallerInfoNotOptional,"'%s' can only be applied to optional arguments" # reshapedmsbuild.fs 1300,toolLocationHelperUnsupportedFrameworkVersion,"The specified .NET Framework version "%s" is not supported. Please specify a value from the enumeration Microsoft.Build.Utilities.TargetDotNetFrameworkVersion." # ----------------------------------------------------------------------------- @@ -1307,3 +1310,8 @@ estApplyStaticArgumentsForMethodNotImplemented,"A type provider implemented GetS 3201,tcModuleAbbrevFirstInMutRec,"In a recursive declaration group, module abbreviations must come after all 'open' declarations and before other declarations" 3202,tcUnsupportedMutRecDecl,"This declaration is not supported in recursive declaration groups" 3203,parsInvalidUseOfRec,"Invalid use of 'rec' keyword" +3204,tcStructUnionMultiCase,"A union type which is a struct must have only one case." +3205,tcUseMayNotBeMutable,"This feature is deprecated. A 'use' binding may not be marked 'mutable'." +3206,CallerMemberNameIsOverriden,"The CallerMemberNameAttribute applied to parameter '%s' will have no effect. It is overridden by the CallerFilePathAttribute." +3207,tcFixedNotAllowed,"Invalid use of 'fixed'. 'fixed' may only be used in a declaration of the form 'use x = fixed expr' where the expression is an array, the address of a field, the address of an array element or a string'" +3208,tcCouldNotFindOffsetToStringData,"Could not find method System.Runtime.CompilerServices.OffsetToStringData in references when building 'fixed' expression." diff --git a/src/fsharp/FSStrings.resx b/src/fsharp/FSStrings.resx index f95cf777b4a..f028e00b6f8 100644 --- a/src/fsharp/FSStrings.resx +++ b/src/fsharp/FSStrings.resx @@ -892,7 +892,7 @@ This expression is a function value, i.e. is missing arguments. Its type is {0}. - This expression should have type 'unit', but has type '{0}'. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name. + The result of this expression is implicitly ignored. Consider using 'ignore' to discard this value explicitly, e.g. 'expr |> ignore', or 'let' to bind the result to a name, e.g. 'let result = expr'. This expression should have type 'unit', but has type '{0}'. If assigning to a property use the syntax 'obj.Prop <- expr'. diff --git a/src/fsharp/FSharp.Build-proto/FSharp.Build-proto.fsproj b/src/fsharp/FSharp.Build-proto/FSharp.Build-proto.fsproj index d8db6885063..31d192aceab 100644 --- a/src/fsharp/FSharp.Build-proto/FSharp.Build-proto.fsproj +++ b/src/fsharp/FSharp.Build-proto/FSharp.Build-proto.fsproj @@ -47,11 +47,18 @@ - - - - - + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Utilities.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Tasks.Core.dll + diff --git a/src/fsharp/FSharp.Build/FSharp.Build.fsproj b/src/fsharp/FSharp.Build/FSharp.Build.fsproj index 407bc789856..e835d52c57a 100644 --- a/src/fsharp/FSharp.Build/FSharp.Build.fsproj +++ b/src/fsharp/FSharp.Build/FSharp.Build.fsproj @@ -55,11 +55,18 @@ - - - - - + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Utilities.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Tasks.Core.dll + diff --git a/src/fsharp/FSharp.Build/project.json b/src/fsharp/FSharp.Build/project.json index 49e360894f7..cdec2ffe079 100644 --- a/src/fsharp/FSharp.Build/project.json +++ b/src/fsharp/FSharp.Build/project.json @@ -1,22 +1,22 @@ -{ - "dependencies": { - "Microsoft.Build": "0.1.0-preview-00022", - "Microsoft.Build.Framework": "0.1.0-preview-00022", - "Microsoft.Build.Tasks.Core": "0.1.0-preview-00022", - "Microsoft.Build.Utilities.Core": "0.1.0-preview-00022", - "Microsoft.NETCore.Platforms": "1.0.1-rc2-24027", - "Microsoft.Win32.Registry": { - "version": "4.0.0-rc2-24027", - "exclude": "Compile" - }, - "System.AppContext": "4.1.0-rc2-24027", - "System.Diagnostics.Tools": "4.0.1-rc2-24027", - "System.Reflection.Primitives": "4.0.1-rc2-24027", - "System.Resources.ResourceManager": "4.0.1-rc2-24027", - }, - "frameworks": { - "dnxcore50": { - "imports": "portable-net45+win8", - } - } -} \ No newline at end of file +{ + "dependencies": { + "Microsoft.Build": "0.1.0-preview-00028-160627", + "Microsoft.Build.Framework": "0.1.0-preview-00028-160627", + "Microsoft.Build.Tasks.Core": "0.1.0-preview-00028-160627", + "Microsoft.Build.Utilities.Core": "0.1.0-preview-00028-160627", + "Microsoft.NETCore.Platforms": "1.0.1", + "Microsoft.Win32.Registry": { + "version": "4.0.0", + "exclude": "Compile" + }, + "System.AppContext": "4.1.0", + "System.Diagnostics.Tools": "4.0.1", + "System.Reflection.Primitives": "4.0.1", + "System.Resources.ResourceManager": "4.0.1" + }, + "frameworks": { + "netstandard1.6": { + "imports": "portable-net45+win8" + } + } +} \ No newline at end of file diff --git a/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj b/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj index 7eb20114970..b005eaa8a68 100644 --- a/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj +++ b/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj @@ -434,12 +434,6 @@ IlxGen.fs - - TraceCall.fsi - - - TraceCall.fs - CompileOps.fsi @@ -467,16 +461,36 @@ + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Utilities.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Tasks.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.DiaSymReader.PortablePdb.1.0.0-rc-60301\lib\portable-net45+win8\Microsoft.DiaSymReader.PortablePdb.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.DiaSymReader.1.0.7\lib\portable-net45+win8\Microsoft.DiaSymReader.dll + + + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0-rc3-23805\lib\portable-net45+win8+wp8+wpa81 + - - ..\..\..\packages\Microsoft.DiaSymReader.PortablePdb.1.0.0-rc-60301\lib\portable-net45+win8\Microsoft.DiaSymReader.PortablePdb.dll - ..\..\..\packages\Microsoft.DiaSymReader.1.0.7\lib\portable-net45+win8\Microsoft.DiaSymReader.dll - ..\..\..\packages\System.Reflection.Metadata.1.3.0-beta-23816\lib\portable-net45+win8\System.Reflection.Metadata.dll - ..\..\..\packages\System.Collections.Immutable.1.2.0-rc3-23805\lib\portable-net45+win8+wp8+wpa81 + ..\..\..\packages\Microsoft.DiaSymReader.PortablePdb.1.1.0\lib\portable-net45+win8\Microsoft.DiaSymReader.PortablePdb.dll + ..\..\..\packages\Microsoft.DiaSymReader.1.0.8\lib\portable-net45+win8\Microsoft.DiaSymReader.dll + ..\..\..\packages\System.Reflection.Metadata.1.4.1-beta-24227-04\lib\portable-net45+win8\System.Reflection.Metadata.dll + ..\..\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81 diff --git a/src/fsharp/FSharp.Compiler.Host.netcore.nuget/Microsoft.FSharp.Compiler.Host.netcore.nuspec b/src/fsharp/FSharp.Compiler.Host.netcore.nuget/Microsoft.FSharp.Compiler.Host.netcore.nuspec index c389117159b..a6dd2dd07f7 100644 --- a/src/fsharp/FSharp.Compiler.Host.netcore.nuget/Microsoft.FSharp.Compiler.Host.netcore.nuspec +++ b/src/fsharp/FSharp.Compiler.Host.netcore.nuget/Microsoft.FSharp.Compiler.Host.netcore.nuspec @@ -3,10 +3,10 @@ Microsoft.FSharp.Compiler.Host.netcore - netcore compatible version of the fsharp compiler fsc.exe. + .NET Core compatible version of the fsharp compiler fsc.exe. Supported Platforms: - - .NET Core (netstandard1.5) + - .NET Core (netstandard1.6) en-US true @@ -16,12 +16,10 @@ $projectUrl$ $tags$ - - - - - - + + + + diff --git a/src/fsharp/FSharp.Compiler.Interactive.Settings/project.json b/src/fsharp/FSharp.Compiler.Interactive.Settings/project.json index 12f15a49c0f..4e1804794a8 100644 --- a/src/fsharp/FSharp.Compiler.Interactive.Settings/project.json +++ b/src/fsharp/FSharp.Compiler.Interactive.Settings/project.json @@ -1,19 +1,19 @@ { "dependencies": { - "Microsoft.NETCore.Platforms": "1.0.1-rc2-24027", - "NETStandard.Library": "1.5.0-rc2-24027", - "System.Linq.Expressions": "4.0.11-rc2-24027", - "System.Reflection.TypeExtensions": "4.1.0-rc2-24027", - "System.Runtime.Loader": "4.0.0-rc2-24027", - "System.Threading.Thread": "4.0.0-rc2-24027", + "Microsoft.NETCore.Platforms": "1.0.1", + "NETStandard.Library": "1.6.0", + "System.Linq.Expressions": "4.1.0", + "System.Reflection.TypeExtensions": "4.1.0", + "System.Runtime.Loader": "4.0.0", + "System.Threading.Thread": "4.0.0" }, "runtimes": { "win7-x86": { }, "win7-x64": { }, - "osx.10.10-x64": { }, + "osx.10.11-x64": { }, "ubuntu.14.04-x64": { } }, "frameworks": { - "netstandard1.5": { } + "netstandard1.6": { } } } diff --git a/src/fsharp/FSharp.Compiler.Server.Shared/FSharp.Compiler.Server.Shared.fsproj b/src/fsharp/FSharp.Compiler.Server.Shared/FSharp.Compiler.Server.Shared.fsproj index be04c8c83f2..62e8f108384 100644 --- a/src/fsharp/FSharp.Compiler.Server.Shared/FSharp.Compiler.Server.Shared.fsproj +++ b/src/fsharp/FSharp.Compiler.Server.Shared/FSharp.Compiler.Server.Shared.fsproj @@ -36,23 +36,16 @@ - - - - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.14.2.25123\lib\net45\Microsoft.VisualStudio.Utilities.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll - + + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll - - - - - - diff --git a/src/fsharp/FSharp.Compiler.netcore.nuget/Microsoft.FSharp.Compiler.netcore.nuspec b/src/fsharp/FSharp.Compiler.netcore.nuget/Microsoft.FSharp.Compiler.netcore.nuspec index beff3bf51c3..849d54eac48 100644 --- a/src/fsharp/FSharp.Compiler.netcore.nuget/Microsoft.FSharp.Compiler.netcore.nuspec +++ b/src/fsharp/FSharp.Compiler.netcore.nuget/Microsoft.FSharp.Compiler.netcore.nuspec @@ -3,8 +3,8 @@ Microsoft.FSharp.Compiler.netcore - netcore compatible version of the fsharp compiler fsc.exe. - Supported Platforms: - .NET Core (.netstandard1.5) + .NET Core compatible version of the fsharp compiler fsc.exe. + Supported Platforms: - .NET Core (.netstandard1.6) en-US true @@ -14,37 +14,34 @@ $projectUrl$ $tags$ - + - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + - - + + - - + + diff --git a/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj b/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj index 9ba9ef50d9f..8432cb86d70 100644 --- a/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj +++ b/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj @@ -29,7 +29,7 @@ $(FSharpSourcesRoot)\..\loc\lcl\{Lang}\$(AssemblyName).dll.lcl $(FSharpSourcesRoot)\..\loc\lci\$(AssemblyName).dll.lci false - false + false @@ -141,12 +141,6 @@ Utilities\lib.fs - - Utilities\TraceCall.fsi - - - Utilities\TraceCall.fs - Utilities\rational.fsi @@ -518,15 +512,35 @@ - + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Utilities.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Tasks.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.DiaSymReader.PortablePdb.1.0.0-rc-60301\lib\portable-net45+win8\Microsoft.DiaSymReader.PortablePdb.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.DiaSymReader.1.0.7\lib\portable-net45+win8\Microsoft.DiaSymReader.dll + + + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0-rc3-23805\lib\portable-net45+win8+wp8+wpa81 + - ..\..\..\packages\Microsoft.DiaSymReader.PortablePdb.1.0.0-rc-60301\lib\portable-net45+win8\Microsoft.DiaSymReader.PortablePdb.dll - ..\..\..\packages\Microsoft.DiaSymReader.1.0.7\lib\portable-net45+win8\Microsoft.DiaSymReader.dll - ..\..\..\packages\System.Reflection.Metadata.1.3.0-beta-23816\lib\portable-net45+win8\System.Reflection.Metadata.dll - ..\..\..\packages\System.Collections.Immutable.1.2.0-rc3-23805\lib\portable-net45+win8+wp8+wpa81 + ..\..\..\packages\Microsoft.DiaSymReader.PortablePdb.1.1.0\lib\portable-net45+win8\Microsoft.DiaSymReader.PortablePdb.dll + ..\..\..\packages\Microsoft.DiaSymReader.1.0.8\lib\portable-net45+win8\Microsoft.DiaSymReader.dll + ..\..\..\packages\System.Reflection.Metadata.1.4.1-beta-24227-04\lib\portable-net45+win8\System.Reflection.Metadata.dll + ..\..\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81 diff --git a/src/fsharp/FSharp.Compiler/InternalsVisibleTo.fs b/src/fsharp/FSharp.Compiler/InternalsVisibleTo.fs index 6c96244239b..8adb8815036 100644 --- a/src/fsharp/FSharp.Compiler/InternalsVisibleTo.fs +++ b/src/fsharp/FSharp.Compiler/InternalsVisibleTo.fs @@ -6,7 +6,6 @@ open System.Reflection [] [] [] -[] [] [] [] @@ -18,6 +17,7 @@ open System.Reflection [] [] [] +[] do() diff --git a/src/fsharp/FSharp.Compiler/project.json b/src/fsharp/FSharp.Compiler/project.json index ac47a5e454c..5ee32fdfe28 100644 --- a/src/fsharp/FSharp.Compiler/project.json +++ b/src/fsharp/FSharp.Compiler/project.json @@ -1,36 +1,33 @@ { "dependencies": { - "Microsoft.NETCore.Platforms": "1.0.1-rc2-24027", - "NETStandard.Library": "1.5.0-rc2-24027", - "System.Collections.Immutable":"1.2.0-rc2-24027", - "System.Diagnostics.Process": "4.1.0-rc2-24027", - "System.Diagnostics.TraceSource": "4.0.0-rc2-24027", - "System.Linq.Expressions": "4.0.11-rc2-24027", - "System.Linq.Queryable": "4.0.1-rc2-24027", - "System.Net.Requests": "4.0.11-rc2-24027", - "System.Reflection.Emit": "4.0.1-rc2-24027", - "System.Reflection.Emit.ILGeneration": "4.0.1-rc2-24027", - "System.Reflection.Metadata": "1.3.0-rc2-24027", - "System.Reflection.TypeExtensions": "4.1.0-rc2-24027", - "System.Runtime.InteropServices": "4.1.0-rc2-24027", - "System.Runtime.InteropServices.PInvoke": "4.0.0-rc2-24027", - "System.Runtime.Loader": "4.0.0-rc2-24027", - "System.Security.Cryptography.Algorithms": "4.1.0-rc2-24027", - "System.Security.Cryptography.Primitives": "4.0.0-rc2-24027", - "System.Threading.Tasks.Parallel": "4.0.1-rc2-24027", - "System.Threading.Thread": "4.0.0-rc2-24027", - "System.Threading.ThreadPool": "4.0.10-rc2-24027", - "Microsoft.DiaSymReader.PortablePdb": "1.0.0-rc-60301", - "Microsoft.DiaSymReader": "1.0.7", + "Microsoft.NETCore.Platforms": "1.0.1", + "NETStandard.Library": "1.6.0", + "System.Collections.Immutable":"1.2.0", + "System.Diagnostics.Process": "4.1.0", + "System.Diagnostics.TraceSource": "4.0.0", + "System.Linq.Expressions": "4.1.0", + "System.Linq.Queryable": "4.0.1", + "System.Net.Requests": "4.0.11", + "System.Reflection.Emit": "4.0.1", + "System.Reflection.Metadata": "1.4.1-beta-24227-04", + "System.Reflection.TypeExtensions": "4.1.0", + "System.Runtime.InteropServices": "4.1.0", + "System.Runtime.Loader": "4.0.0", + "System.Security.Cryptography.Algorithms": "4.2.0", + "System.Threading.Tasks.Parallel": "4.0.1", + "System.Threading.Thread": "4.0.0", + "System.Threading.ThreadPool": "4.0.10", + "Microsoft.DiaSymReader.PortablePdb": "1.1.0", + "Microsoft.DiaSymReader": "1.0.8" }, "runtimes": { "win7-x86": { }, "win7-x64": { }, - "osx.10.10-x64": { }, + "osx.10.11-x64": { }, "ubuntu.14.04-x64": { } }, "frameworks": { - "netstandard1.5": { + "netstandard1.6": { "imports": "portable-net45+win8" } } diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core.Unittests.fsproj b/src/fsharp/FSharp.Core.Unittests/FSharp.Core.Unittests.fsproj index 83ed633defa..9e389c299e6 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core.Unittests.fsproj +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core.Unittests.fsproj @@ -112,7 +112,7 @@ - + @@ -120,6 +120,7 @@ + diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/DiscrimantedUnionType.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/DiscrimantedUnionType.fs index 42f038b67bc..517e69a9200 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/DiscrimantedUnionType.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/DiscrimantedUnionType.fs @@ -1,10 +1,25 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -namespace FSharp.Core.Unittests.FSharp_Core.Microsoft_FSharp_Core +module FSharp.Core.Unittests.FSharp_Core.Microsoft_FSharp_Core.DiscriminatedUnionTypes open System open System.Numerics +open System.Reflection +open System.Runtime.InteropServices open FSharp.Core.Unittests.LibraryTestFx open NUnit.Framework +open FsCheck +open FsCheck.PropOperators + +#if FX_RESHAPED_REFLECTION +open FSharp.Reflection.FSharpReflectionExtensions + +[] +module PrimReflectionAdapters = + + type System.Type with + member this.IsValueType = this.GetTypeInfo().IsValueType +#endif + type EnumUnion = | A @@ -95,4 +110,142 @@ type UseUnionsWithData() = | _ -> Assert.Fail() match a2 with | Alpha x when x = 2 -> () - | _ -> Assert.Fail() \ No newline at end of file + | _ -> Assert.Fail() + +[] +type StructUnion = SU of C : int * D : int + +let private hasAttribute<'T,'Attr>() = + typeof<'T>.GetTypeInfo().GetCustomAttributes() |> Seq.exists (fun x -> x.GetType() = typeof<'Attr>) + + +let [] ``struct unions hold [] metadata`` () = + Assert.IsTrue (hasAttribute()) + + +let [] ``struct unions are comparable`` () = + Check.QuickThrowOnFailure <| + fun (i1:int) (i2:int) -> + i1 <> i2 ==> + let sr1 = SU (i1, i2) + let sr2 = SU (i1, i2) + let sr3 = SU (i2, i1) + (sr1 = sr2) |@ "sr1 = sr2" .&. + (sr1 <> sr3) |@ "sr1 <> sr3" .&. + (sr1.Equals sr2) |@ "sr1.Equals sr2" + + +let [] ``struct unions support pattern matching`` () = + Check.QuickThrowOnFailure <| + fun (i1:int) (i2:int) -> + let sr1 = SU(i1, i2) + (match sr1 with + | SU(c,d) when c = i1 && d = i2 -> true + | _ -> false) + |@ "with pattern match on struct union" .&. + (sr1 |> function + | SU(c,d) when c = i1 && d = i2 -> true + | _ -> false) + |@ "function pattern match on struct union" + + +let [] ``struct unions support let binds using `` () = + Check.QuickThrowOnFailure <| + fun (i1:int) (i2:int) -> + let sr1 = SU(i1,i2) + let (SU (c1,d2)) as sr2 = sr1 + (sr1 = sr2) |@ "sr1 = sr2" .&. + (c1 = i1 && d2 = i2) |@ "c1 = i1 && d2 = i2" + + +let [] ``struct unions support function argument bindings`` () = + Check.QuickThrowOnFailure <| + fun (i1:int) (i2:int) -> + let sr1 = SU(i1,i2) + let test sr1 (SU (c1,d2) as sr2) = + sr1 = sr2 && c1 = i1 && d2 = i2 + test sr1 sr1 + + + +[] +[] +type ComparisonStructUnion = + | SU2 of int * int + member x.C1 = (match x with SU2(a,b) -> a) + member x.C2 = (match x with SU2(a,b) -> b) + override self.Equals other = + match other with + | :? ComparisonStructUnion as o -> (self.C1 + self.C2) = (o.C1 + o.C2) + | _ -> false + + override self.GetHashCode() = hash self + interface IComparable with + member self.CompareTo other = + match other with + | :? ComparisonStructUnion as o -> compare (self.C1 + self.C2) (o.C1 + o.C2) + | _ -> invalidArg "other" "cannot compare values of different types" + + +[] +let ``struct unions support []`` () = + Check.QuickThrowOnFailure <| + fun (i1:int) (i2:int) -> + let sr1 = SU2(i1,i2) + let sr2 = SU2(i1,i2) + (sr1.Equals sr2) + + +[] +let ``struct unions support []`` () = + Check.QuickThrowOnFailure <| + fun (i1:int) (i2:int) (k1:int) (k2:int) -> + let sr1 = SU2(i1,i2) + let sr2 = SU2(k1,k2) + if sr1 > sr2 then compare sr1 sr2 = 1 + elif sr1 < sr2 then compare sr1 sr2 = -1 + elif sr1 = sr2 then compare sr1 sr2 = 0 + else false + + +[] +let ``struct unions hold [] [] metadata`` () = + Assert.IsTrue (hasAttribute()) + Assert.IsTrue (hasAttribute()) + + +[] +[] +type NoComparisonStructUnion = + | SU3 of int * int + + + +[] +let ``struct unions hold [] [] metadata`` () = + Assert.IsTrue (hasAttribute()) + Assert.IsTrue (hasAttribute()) + + +let [] ``can properly construct a struct union using FSharpValue.MakeUnionCase, and we get the fields`` () = + let cases = Microsoft.FSharp.Reflection.FSharpType.GetUnionCases(typeof) + + Assert.AreEqual (1, cases.Length) + let case = cases.[0] + + Assert.AreEqual ("SU", case.Name) + + let structUnion = Microsoft.FSharp.Reflection.FSharpValue.MakeUnion (case, [|box 1234; box 3456|]) + + Assert.IsTrue (structUnion.GetType().IsValueType) + + let _uc, fieldVals = Microsoft.FSharp.Reflection.FSharpValue.GetUnionFields(structUnion, typeof) + + Assert.AreEqual (2, fieldVals.Length) + + let c = (fieldVals.[0] :?> int) + Assert.AreEqual (1234, c) + + let c2 = (fieldVals.[1] :?> int) + Assert.AreEqual (3456, c2) + diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index cfa03d36597..3f5aff83e1f 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -584,96 +584,4 @@ type AsyncModule() = Assert.AreEqual(0, !okCount) Assert.AreEqual(0, !errCount) #endif -#endif - -#if FSHARP_CORE_PORTABLE -// nothing -#else -#if FSHARP_CORE_2_0 -// nothing -#else -#if FSHARP_CORE_NETCORE_PORTABLE || coreclr -//nothing -#else -// we are on the desktop - member this.RunExeAndExpectOutput(exeName, expected:string) = - let curDir = (new Uri(System.Reflection.Assembly.GetExecutingAssembly().CodeBase)).LocalPath |> System.IO.Path.GetDirectoryName - let psi = System.Diagnostics.ProcessStartInfo(exeName) - psi.WorkingDirectory <- curDir - psi.RedirectStandardOutput <- true - psi.UseShellExecute <- false - let p = System.Diagnostics.Process.Start(psi) - let out = p.StandardOutput.ReadToEnd() - p.WaitForExit() - let out = out.Replace("\r\n", "\n") - let expected = expected.Replace("\r\n", "\n") - Assert.AreEqual(expected, out) -#if OPEN_BUILD -#else - [] - member this.``ContinuationsThreadingDetails.AsyncWithSyncContext``() = - this.RunExeAndExpectOutput("AsyncWithSyncContext.exe", """ -EmptyParallel [|("ok", true); ("caught:boom", true)|] -NonEmptyParallel [|("ok", true); ("form exception:boom", true)|] -ParallelSeqArgumentThrows [|("error", true)|] -Sleep1Return [|("ok", true); ("form exception:boom", true)|] -Sleep0Return [|("ok", true); ("form exception:boom", true)|] -Return [|("ok", true); ("caught:boom", true)|] -FromContinuationsSuccess [|("ok", true); ("caught:boom", true)|] -FromContinuationsError [|("error", true)|] -FromContinuationsCancel [|("cancel", true)|] -FromContinuationsThrows [|("error", true)|] -FromContinuationsSchedulesFutureSuccess [|("ok", false); ("unhandled", false)|] -FromContinuationsSchedulesFutureError [|("error", false)|] -FromContinuationsSchedulesFutureCancel [|("cancel", false)|] -FromContinuationsSchedulesFutureSuccessAndThrowsQuickly [|("error", true); ("unhandled", false)|] -FromContinuationsSchedulesFutureErrorAndThrowsQuickly [|("error", true); ("unhandled", false)|] -FromContinuationsSchedulesFutureCancelAndThrowsQuickly [|("error", true); ("unhandled", false)|] -FromContinuationsSchedulesFutureSuccessAndThrowsSlowly [|("ok", false); ("unhandled", false); - ("caught:A continuation provided by Async.FromContinuations was invoked multiple times", - true)|] -FromContinuationsSchedulesFutureErrorAndThrowsSlowly [|("error", false); - ("caught:A continuation provided by Async.FromContinuations was invoked multiple times", - true)|] -FromContinuationsSchedulesFutureCancelAndThrowsSlowly [|("cancel", false); - ("caught:A continuation provided by Async.FromContinuations was invoked multiple times", - true)|] -AwaitWaitHandleAlreadySignaled0 [|("ok", true); ("caught:boom", true)|] -AwaitWaitHandleAlreadySignaled1 [|("ok", true); ("form exception:boom", true)|] -""" ) - [] - member this.``ContinuationsThreadingDetails.AsyncSansSyncContext``() = - this.RunExeAndExpectOutput("AsyncSansSyncContext.exe", """ -EmptyParallel [|("ok", true); ("caught:boom", true)|] -NonEmptyParallel [|("ok", false); ("unhandled", false)|] -ParallelSeqArgumentThrows [|("error", true)|] -Sleep1Return [|("ok", false); ("unhandled", false)|] -Sleep0Return [|("ok", false); ("unhandled", false)|] -Return [|("ok", true); ("caught:boom", true)|] -FromContinuationsSuccess [|("ok", true); ("caught:boom", true)|] -FromContinuationsError [|("error", true)|] -FromContinuationsCancel [|("cancel", true)|] -FromContinuationsThrows [|("error", true)|] -FromContinuationsSchedulesFutureSuccess [|("ok", false); ("unhandled", false)|] -FromContinuationsSchedulesFutureError [|("error", false)|] -FromContinuationsSchedulesFutureCancel [|("cancel", false)|] -FromContinuationsSchedulesFutureSuccessAndThrowsQuickly [|("error", true); ("unhandled", false)|] -FromContinuationsSchedulesFutureErrorAndThrowsQuickly [|("error", true); ("unhandled", false)|] -FromContinuationsSchedulesFutureCancelAndThrowsQuickly [|("error", true); ("unhandled", false)|] -FromContinuationsSchedulesFutureSuccessAndThrowsSlowly [|("ok", false); ("unhandled", false); - ("caught:A continuation provided by Async.FromContinuations was invoked multiple times", - true)|] -FromContinuationsSchedulesFutureErrorAndThrowsSlowly [|("error", false); - ("caught:A continuation provided by Async.FromContinuations was invoked multiple times", - true)|] -FromContinuationsSchedulesFutureCancelAndThrowsSlowly [|("cancel", false); - ("caught:A continuation provided by Async.FromContinuations was invoked multiple times", - true)|] -AwaitWaitHandleAlreadySignaled0 [|("ok", true); ("caught:boom", true)|] -AwaitWaitHandleAlreadySignaled1 [|("ok", false); ("unhandled", false)|] -""" ) -#endif - -#endif -#endif #endif \ No newline at end of file diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Core/ResultTests.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Core/ResultTests.fs new file mode 100644 index 00000000000..0eefa2126f1 --- /dev/null +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Core/ResultTests.fs @@ -0,0 +1,44 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +// Various tests for: +// Microsoft.FSharp.Core.Result + +namespace FSharp.Core.Unittests.FSharp_Core.Microsoft_FSharp_Core + +open System +open FSharp.Core.Unittests.LibraryTestFx +open NUnit.Framework + +type EmailValidation= + | Empty + | NoAt + +module Results= + let bind f m = match m with Error e -> Error e | Ok x -> f x + +open Results + +[] +type ResultTests() = + + let fail_if_empty email= + if String.IsNullOrEmpty(email) then Error Empty else Ok email + + let fail_if_not_at (email:string)= + if (email.Contains("@")) then Ok email else Error NoAt + + let validate_email = + fail_if_empty + >> bind fail_if_not_at + + let test_validate_email email (expected:Result) = + let actual = validate_email email + Assert.AreEqual(expected, actual) + + + [] + member this.CanChainTogetherSuccessiveValidations() = + test_validate_email "" (Error Empty) + test_validate_email "something_else" (Error NoAt) + test_validate_email "some@email.com" (Ok "some@email.com") + diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/RecordTypes.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/RecordTypes.fs index 694052fa4d2..2d9695b08fa 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/RecordTypes.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/RecordTypes.fs @@ -325,4 +325,48 @@ let [] ``can properly construct a struct record using FSharpValue.MakeReco let d = (fields.[1] :?> int) Assert.AreEqual (999, d) - \ No newline at end of file +type DefaultLayoutMutableRecord = + { mutable First : int + mutable Second : float + mutable Third : decimal + mutable Fourth : int + } + +let inline CX_get_A(x: ^T) = + ( (^T : (member A : int) (x)) ) + +let inline CX_get_C(x: ^T) = + ( (^T : (member C : int) (x)) ) + +let inline CX_set_First(x: ^T, v) = + ( (^T : (member First : int with set) (x,v)) ) + + +type Members() = + static member CreateMutableStructRecord() = { M1 = 1; M2 = 2 } + + +let [] ``inline constraints resolve correctly`` () = + let v = CX_get_A ({ A = 1; B = 2 }) + Assert.AreEqual (1, v) + + let v2 = CX_get_C ({ C = 1; D = 2 }) + Assert.AreEqual (1, v2) + + let mutable m : DefaultLayoutMutableRecord = + { First = 0xbaad1 + Second = 0.987654 + Third = 100.32M + Fourth = 0xbaad4 } + + let v3 = CX_set_First (m,1) + Assert.AreEqual (1, m.First) + +let [] ``member setters resolve correctly`` () = + + let v = Members.CreateMutableStructRecord() + Assert.AreEqual (1, v.M1) + + //let v2 = Members.CreateMutableStructRecord(M1 = 100) + //Assert.AreEqual (100, v2.M1) + diff --git a/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs b/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs index af62c8ffb75..6fe9224d6a8 100644 --- a/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs +++ b/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs @@ -126,12 +126,7 @@ module SurfaceArea = // verify public surface area matches expected let verify expected platform fileName = - let workDir = - #if OPEN_BUILD - TestContext.CurrentContext.WorkDirectory - #else - "" - #endif + let workDir = TestContext.CurrentContext.WorkDirectory let logFile = sprintf "%s\\CoreUnit_%s_Xml.xml" workDir platform let normalize (s:string) = Regex.Replace(s, "(\\r\\n|\\n)+", "\r\n").Trim([|'\r';'\n'|]) diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.Silverlight.2.0.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.Silverlight.2.0.fs index 3d933f40517..0d5f50d6290 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.Silverlight.2.0.fs +++ b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.Silverlight.2.0.fs @@ -1821,6 +1821,69 @@ Microsoft.FSharp.Core.FSharpRef`1[T]: T get_contents() Microsoft.FSharp.Core.FSharpRef`1[T]: Void .ctor(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_Value(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_contents(T) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError Item +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T Item +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Error +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Ok +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewError(TError) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewOk(T) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.Type GetType() Microsoft.FSharp.Core.FSharpTypeFunc: Boolean Equals(System.Object) Microsoft.FSharp.Core.FSharpTypeFunc: Int32 GetHashCode() Microsoft.FSharp.Core.FSharpTypeFunc: System.Object Specialize[T]() diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net20.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net20.fs index c8caf782564..104874e1a6a 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net20.fs +++ b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net20.fs @@ -2000,6 +2000,69 @@ Microsoft.FSharp.Core.FSharpRef`1[T]: T get_contents() Microsoft.FSharp.Core.FSharpRef`1[T]: Void .ctor(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_Value(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_contents(T) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError Item +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T Item +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Error +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Ok +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewError(TError) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewOk(T) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.Type GetType() Microsoft.FSharp.Core.FSharpTypeFunc: Boolean Equals(System.Object) Microsoft.FSharp.Core.FSharpTypeFunc: Int32 GetHashCode() Microsoft.FSharp.Core.FSharpTypeFunc: System.Object Specialize[T]() diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net40.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net40.fs index 6879946205f..492dd473b10 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net40.fs +++ b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net40.fs @@ -2161,6 +2161,69 @@ Microsoft.FSharp.Core.FSharpRef`1[T]: T get_contents() Microsoft.FSharp.Core.FSharpRef`1[T]: Void .ctor(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_Value(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_contents(T) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError Item +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T Item +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Error +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Ok +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewError(TError) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewOk(T) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.Type GetType() Microsoft.FSharp.Core.FSharpTypeFunc: Boolean Equals(System.Object) Microsoft.FSharp.Core.FSharpTypeFunc: Int32 GetHashCode() Microsoft.FSharp.Core.FSharpTypeFunc: System.Object Specialize[T]() diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable259.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable259.fs index 2102f9d951d..eb21e466f4f 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable259.fs +++ b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable259.fs @@ -2137,6 +2137,69 @@ Microsoft.FSharp.Core.FSharpRef`1[T]: T get_contents() Microsoft.FSharp.Core.FSharpRef`1[T]: Void .ctor(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_Value(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_contents(T) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError Item +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T Item +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Error +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Ok +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewError(TError) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewOk(T) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.Type GetType() Microsoft.FSharp.Core.FSharpTypeFunc: Boolean Equals(System.Object) Microsoft.FSharp.Core.FSharpTypeFunc: Int32 GetHashCode() Microsoft.FSharp.Core.FSharpTypeFunc: System.Object Specialize[T]() diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable47.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable47.fs index 856107f69f2..d1fed8d0a16 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable47.fs +++ b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable47.fs @@ -2134,6 +2134,69 @@ Microsoft.FSharp.Core.FSharpRef`1[T]: T get_contents() Microsoft.FSharp.Core.FSharpRef`1[T]: Void .ctor(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_Value(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_contents(T) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError Item +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T Item +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Error +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Ok +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewError(TError) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewOk(T) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.Type GetType() Microsoft.FSharp.Core.FSharpTypeFunc: Boolean Equals(System.Object) Microsoft.FSharp.Core.FSharpTypeFunc: Int32 GetHashCode() Microsoft.FSharp.Core.FSharpTypeFunc: System.Object Specialize[T]() diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable7.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable7.fs index 745df1359bf..3916c3bf8ce 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable7.fs +++ b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable7.fs @@ -2150,6 +2150,69 @@ Microsoft.FSharp.Core.FSharpRef`1[T]: T get_contents() Microsoft.FSharp.Core.FSharpRef`1[T]: Void .ctor(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_Value(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_contents(T) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError Item +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T Item +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Error +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Ok +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewError(TError) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewOk(T) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.Type GetType() Microsoft.FSharp.Core.FSharpTypeFunc: Boolean Equals(System.Object) Microsoft.FSharp.Core.FSharpTypeFunc: Int32 GetHashCode() Microsoft.FSharp.Core.FSharpTypeFunc: System.Object Specialize[T]() diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable78.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable78.fs index 72df723cf36..1520f4cb004 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable78.fs +++ b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable78.fs @@ -2137,6 +2137,69 @@ Microsoft.FSharp.Core.FSharpRef`1[T]: T get_contents() Microsoft.FSharp.Core.FSharpRef`1[T]: Void .ctor(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_Value(T) Microsoft.FSharp.Core.FSharpRef`1[T]: Void set_contents(T) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError Item +Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError]: TError get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T Item +Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError]: T get_Item() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Error +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: Int32 Ok +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError]: System.Type GetType() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsError +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean IsOk +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsError() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Boolean get_IsOk() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(Microsoft.FSharp.Core.FSharpResult`2[T,TError]) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 CompareTo(System.Object, System.Collections.IComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 Tag +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Int32 get_Tag() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Error[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Ok[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2+Tags[T,TError] +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewError(TError) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: Microsoft.FSharp.Core.FSharpResult`2[T,TError] NewOk(T) +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.String ToString() +Microsoft.FSharp.Core.FSharpResult`2[T,TError]: System.Type GetType() Microsoft.FSharp.Core.FSharpTypeFunc: Boolean Equals(System.Object) Microsoft.FSharp.Core.FSharpTypeFunc: Int32 GetHashCode() Microsoft.FSharp.Core.FSharpTypeFunc: System.Object Specialize[T]() diff --git a/src/fsharp/FSharp.Core.Unittests/project.json b/src/fsharp/FSharp.Core.Unittests/project.json index 2ab29cb86b4..79647ccbf80 100644 --- a/src/fsharp/FSharp.Core.Unittests/project.json +++ b/src/fsharp/FSharp.Core.Unittests/project.json @@ -1,23 +1,24 @@ { "dependencies": { - "Microsoft.NETCore.Platforms": "1.0.1-rc2-24027", - "NETStandard.Library": "1.5.0-rc2-24027", - "System.Linq.Expressions": "4.0.11-rc2-24027", - "System.Linq.Queryable": "4.0.1-rc2-24027", - "System.Reflection.Emit": "4.0.1-rc2-24027", - "System.Runtime.Loader": "4.0.0-rc2-24027", - "System.Net.Requests": "4.0.11-rc2-24027", - "System.Threading.Tasks.Parallel": "4.0.1-rc2-24027", - "System.Threading.Thread": "4.0.0-rc2-24027", - "System.Threading.ThreadPool": "4.0.10-rc2-24027", + "Microsoft.NETCore.Platforms": "1.0.1", + "NETStandard.Library": "1.6.0", + "System.Linq.Expressions": "4.1.0", + "System.Linq.Queryable": "4.0.1", + "System.Net.Requests": "4.0.11", + "System.Reflection.Emit": "4.0.1", + "System.Runtime.Loader": "4.0.0", + "System.Text.RegularExpressions": "4.1.0", + "System.Threading.Tasks.Parallel": "4.0.1", + "System.Threading.Thread": "4.0.0", + "System.Threading.ThreadPool": "4.0.10" }, "runtimes": { "win7-x86": { }, "win7-x64": { }, - "osx.10.10-x64": { }, + "osx.10.11-x64": { }, "ubuntu.14.04-x64": { } }, "frameworks": { - "netstandard1.5": { } + "netstandard1.6": { } } } diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 298da186887..a33b91faf4b 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -600,7 +600,7 @@ namespace Microsoft.FSharp.Control let mutable defaultCancellationTokenSource = new CancellationTokenSource() [] - type Result<'T> = + type AsyncImplResult<'T> = | Ok of 'T | Error of ExceptionDispatchInfo | Canceled of OperationCanceledException @@ -804,9 +804,9 @@ namespace Microsoft.FSharp.Control let reify res = unprotectedPrimitive (fun args -> match res with - | Result.Ok r -> args.cont r - | Result.Error e -> args.aux.econt e - | Result.Canceled oce -> args.aux.ccont oce) + | AsyncImplResult.Ok r -> args.cont r + | AsyncImplResult.Error e -> args.aux.econt e + | AsyncImplResult.Canceled oce -> args.aux.ccont oce) //---------------------------------- // BUILDER OPREATIONS @@ -1235,7 +1235,7 @@ namespace Microsoft.FSharp.Control let subSource = new LinkedSubSource(token) subSource.Token, Some subSource - use resultCell = new ResultCell>() + use resultCell = new ResultCell>() queueAsync token (fun res -> resultCell.RegisterResult(Ok(res),reuseThread=true)) @@ -1261,7 +1261,7 @@ namespace Microsoft.FSharp.Control commit res let private RunSynchronouslyInCurrentThread (token:CancellationToken,computation) = - use resultCell = new ResultCell>() + use resultCell = new ResultCell>() let trampolineHolder = TrampolineHolder() trampolineHolder.Protect @@ -1791,7 +1791,7 @@ namespace Microsoft.FSharp.Control /// Await the result of a result cell without a timeout - static member ReifyResult(result:Result<'T>) : Async<'T> = + static member ReifyResult(result:AsyncImplResult<'T>) : Async<'T> = unprotectedPrimitive(fun ({ aux = aux } as args) -> (match result with | Ok v -> args.cont v @@ -1799,7 +1799,7 @@ namespace Microsoft.FSharp.Control | Canceled exn -> aux.ccont exn) ) /// Await the result of a result cell without a timeout - static member AwaitAndReifyResult(resultCell:ResultCell>) : Async<'T> = + static member AwaitAndReifyResult(resultCell:ResultCell>) : Async<'T> = async { let! result = resultCell.AwaitResult return! Async.ReifyResult(result) @@ -1811,7 +1811,7 @@ namespace Microsoft.FSharp.Control /// /// Always resyncs to the synchronization context if needed, by virtue of it being built /// from primitives which resync. - static member AsyncWaitAsyncWithTimeout(innerCTS : CancellationTokenSource, resultCell:ResultCell>,millisecondsTimeout) : Async<'T> = + static member AsyncWaitAsyncWithTimeout(innerCTS : CancellationTokenSource, resultCell:ResultCell>,millisecondsTimeout) : Async<'T> = match millisecondsTimeout with | None | Some -1 -> resultCell |> Async.AwaitAndReifyResult @@ -1917,9 +1917,9 @@ namespace Microsoft.FSharp.Control let cts = new CancellationTokenSource() - let result = new ResultCell>() + let result = new ResultCell>() - member s.SetResult(v: Result<'T>) = + member s.SetResult(v: AsyncImplResult<'T>) = result.RegisterResult(v,reuseThread=true) |> unfake match callback with | null -> () @@ -2206,7 +2206,7 @@ namespace Microsoft.FSharp.Control | :? System.Net.WebException as webExn when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && !canceled -> - Async.ReifyResult(Result.Canceled (OperationCanceledException webExn.Message)) + Async.ReifyResult(AsyncImplResult.Canceled (OperationCanceledException webExn.Message)) | _ -> edi.ThrowAny()) @@ -2278,9 +2278,9 @@ namespace Microsoft.FSharp.Control let! ct = Async.CancellationToken let start a f = Async.StartWithContinuationsUsingDispatchInfo(a, - (fun res -> c.RegisterResult(f res |> Result.Ok, reuseThread=false) |> unfake), - (fun edi -> c.RegisterResult(edi |> Result.Error, reuseThread=false) |> unfake), - (fun oce -> c.RegisterResult(oce |> Result.Canceled, reuseThread=false) |> unfake), + (fun res -> c.RegisterResult(f res |> AsyncImplResult.Ok, reuseThread=false) |> unfake), + (fun edi -> c.RegisterResult(edi |> AsyncImplResult.Error, reuseThread=false) |> unfake), + (fun oce -> c.RegisterResult(oce |> AsyncImplResult.Canceled, reuseThread=false) |> unfake), cancellationToken = ct ) start a1 Choice1Of2 diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 43531b98838..3cfbd74f3f7 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -3470,6 +3470,12 @@ namespace Microsoft.FSharp.Core and 'T option = Option<'T> + [] + [] + type Result<'T,'TError> = + | Ok of 'T + | Error of 'TError + //============================================================================ //============================================================================ diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index d3202b3aeee..ad84f0fd2d3 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -1770,6 +1770,15 @@ namespace Microsoft.FSharp.Core and 'T option = Option<'T> + ///

Helper type for error handling without exceptions. + [] + [] + type Result<'T,'TError> = + /// Represents an OK or a Successful result. The code succeeded with a value of 'T. + | Ok of 'T + /// Represents an Error or a Failure. The code failed with a value of 'TError representing what went wrong. + | Error of 'TError + namespace Microsoft.FSharp.Collections open System diff --git a/src/fsharp/FSharp.Core/project.json b/src/fsharp/FSharp.Core/project.json index d3ee8bd7886..c14efc45130 100644 --- a/src/fsharp/FSharp.Core/project.json +++ b/src/fsharp/FSharp.Core/project.json @@ -1,38 +1,38 @@ { "dependencies": { - "Microsoft.NETCore.Platforms": "1.0.1-rc2-24027", - "Microsoft.NETCore.Runtime": "1.0.2-rc2-24027", - "System.Collections": "4.0.11-rc2-24027", - "System.Console": "4.0.0-rc2-24027", - "System.Diagnostics.Debug": "4.0.11-rc2-24027", - "System.Diagnostics.Tools": "4.0.1-rc2-24027", - "System.Globalization": "4.0.11-rc2-24027", - "System.IO": "4.1.0-rc2-24027", - "System.Linq": "4.1.0-rc2-24027", - "System.Linq.Expressions": "4.0.11-rc2-24027", - "System.Linq.Queryable": "4.0.1-rc2-24027", - "System.Net.Requests": "4.0.11-rc2-24027", - "System.Reflection": "4.1.0-rc2-24027", - "System.Reflection.Extensions": "4.0.1-rc2-24027", - "System.Resources.ResourceManager":"4.0.1-rc2-24027", - "System.Runtime": "4.1.0-rc2-24027", - "System.Runtime.Extensions": "4.1.0-rc2-24027", - "System.Runtime.Numerics": "4.0.1-rc2-24027", - "System.Text.RegularExpressions": "4.0.12-rc2-24027", - "System.Threading": "4.0.11-rc2-24027", - "System.Threading.Tasks": "4.0.11-rc2-24027", - "System.Threading.Tasks.Parallel": "4.0.1-rc2-24027", - "System.Threading.Thread": "4.0.0-rc2-24027", - "System.Threading.ThreadPool": "4.0.10-rc2-24027", - "System.Threading.Timer": "4.0.1-rc2-24027" + "Microsoft.NETCore.Platforms": "1.0.1", + "Microsoft.NETCore.Runtime.CoreCLR": "1.0.2", + "System.Collections": "4.0.11", + "System.Console": "4.0.0", + "System.Diagnostics.Debug": "4.0.11", + "System.Diagnostics.Tools": "4.0.1", + "System.Globalization": "4.0.11", + "System.IO": "4.1.0", + "System.Linq": "4.1.0", + "System.Linq.Expressions": "4.1.0", + "System.Linq.Queryable": "4.0.1", + "System.Net.Requests": "4.0.11", + "System.Reflection": "4.1.0", + "System.Reflection.Extensions": "4.0.1", + "System.Resources.ResourceManager":"4.0.1", + "System.Runtime": "4.1.0", + "System.Runtime.Extensions": "4.1.0", + "System.Runtime.Numerics": "4.0.1", + "System.Text.RegularExpressions": "4.1.0", + "System.Threading": "4.0.11", + "System.Threading.Tasks": "4.0.11", + "System.Threading.Tasks.Parallel": "4.0.1", + "System.Threading.Thread": "4.0.0", + "System.Threading.ThreadPool": "4.0.10", + "System.Threading.Timer": "4.0.1" }, "runtimes": { "win7-x86": { }, "win7-x64": { }, - "osx.10.10-x64": { }, + "osx.10.11-x64": { }, "ubuntu.14.04-x64": { } }, "frameworks": { - "netstandard1.5": { } + "netstandard1.6": { } } } diff --git a/src/fsharp/FSharp.Data.TypeProviders/FSharp.Data.TypeProviders.fsproj b/src/fsharp/FSharp.Data.TypeProviders/FSharp.Data.TypeProviders.fsproj deleted file mode 100644 index 810ecac2122..00000000000 --- a/src/fsharp/FSharp.Data.TypeProviders/FSharp.Data.TypeProviders.fsproj +++ /dev/null @@ -1,47 +0,0 @@ - - - - - ..\.. - - - - Debug - AnyCPU - Library - FSharp.Data.TypeProviders - true - {cb7d20c4-6506-406d-9144-5342c3595f03} - $(OtherFlags) --warnon:1182 - - - - - - - TypeProviderRuntimeAttribute.fs - true - - - - - - assemblyinfo.FSharp.Data.TypeProviders.dll.fs - - - - - - - - - - {DED3BBD7-53F4-428A-8C9F-27968E768605} - FSharp.Core - - - - \ No newline at end of file diff --git a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj index 189ff8c596e..f7d1e977252 100644 --- a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj +++ b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj @@ -151,9 +151,6 @@ Utilities\rational.fs - - Utilities\TraceCall.fs - ErrorLogging\range.fsi @@ -564,32 +561,53 @@ - - + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll + - + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.14.2.25123\lib\net45\Microsoft.VisualStudio.Shell.Design.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Utilities.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Tasks.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.DiaSymReader.PortablePdb.1.0.0-rc-60301\lib\portable-net45+win8\Microsoft.DiaSymReader.PortablePdb.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.DiaSymReader.1.0.7\lib\portable-net45+win8\Microsoft.DiaSymReader.dll + + + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0-rc3-23805\lib\portable-net45+win8+wp8+wpa81 + - ..\..\..\packages\Microsoft.DiaSymReader.PortablePdb.1.0.0-rc-60301\lib\portable-net45+win8\Microsoft.DiaSymReader.PortablePdb.dll - ..\..\..\packages\Microsoft.DiaSymReader.1.0.7\lib\portable-net45+win8\Microsoft.DiaSymReader.dll - ..\..\..\packages\System.Reflection.Metadata.1.3.0-beta-23816\lib\portable-net45+win8\System.Reflection.Metadata.dll - ..\..\..\packages\System.Collections.Immutable.1.2.0-rc3-23805\lib\portable-net45+win8+wp8+wpa81 + ..\..\..\packages\Microsoft.DiaSymReader.PortablePdb.1.1.0\lib\portable-net45+win8\Microsoft.DiaSymReader.PortablePdb.dll + ..\..\..\packages\Microsoft.DiaSymReader.1.0.8\lib\portable-net45+win8\Microsoft.DiaSymReader.dll + ..\..\..\packages\System.Reflection.Metadata.1.4.1-beta-24227-04\lib\portable-net45+win8\System.Reflection.Metadata.dll + ..\..\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81 {DED3BBD7-53F4-428A-8C9F-27968E768605} FSharp.Core diff --git a/src/fsharp/FSharp.LanguageService.Compiler/InternalsVisibleTo.fs b/src/fsharp/FSharp.LanguageService.Compiler/InternalsVisibleTo.fs index 319ad669029..0460b3c185d 100644 --- a/src/fsharp/FSharp.LanguageService.Compiler/InternalsVisibleTo.fs +++ b/src/fsharp/FSharp.LanguageService.Compiler/InternalsVisibleTo.fs @@ -6,7 +6,6 @@ open System.Reflection [] [] [] -[] [] [] [] @@ -16,7 +15,7 @@ open System.Reflection [] [] [] - +[] do() diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index 66f421f3522..0635dc3c189 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -29,9 +29,9 @@ open Microsoft.FSharp.Compiler.Infos type env = Nix type cenv = - { g: TcGlobals; - amap: Import.ImportMap; - denv: DisplayEnv; + { g: TcGlobals + amap: Import.ImportMap + denv: DisplayEnv mutable unsolved: Typars } let accTy cenv _env ty = @@ -50,29 +50,29 @@ let rec accExpr (cenv:cenv) (env:env) expr = let expr = stripExpr expr match expr with | Expr.Sequential (e1,e2,_,_,_) -> - accExpr cenv env e1; + accExpr cenv env e1 accExpr cenv env e2 | Expr.Let (bind,body,_,_) -> - accBind cenv env bind ; + accBind cenv env bind accExpr cenv env body | Expr.Const (_,_,ty) -> accTy cenv env ty | Expr.Val (_v,_vFlags,_m) -> () | Expr.Quote(ast,_,_,_m,ty) -> - accExpr cenv env ast; - accTy cenv env ty; + accExpr cenv env ast + accTy cenv env ty | Expr.Obj (_,typ,basev,basecall,overrides,iimpls,_m) -> accTy cenv env typ - accExpr cenv env basecall; - accMethods cenv env basev overrides ; - accIntfImpls cenv env basev iimpls; + accExpr cenv env basecall + accMethods cenv env basev overrides + accIntfImpls cenv env basev iimpls | Expr.Op (c,tyargs,args,m) -> accOp cenv env (c,tyargs,args,m) | Expr.App(f,fty,tyargs,argsl,_m) -> - accTy cenv env fty; - accTypeInst cenv env tyargs; - accExpr cenv env f; + accTy cenv env fty + accTypeInst cenv env tyargs + accExpr cenv env f accExprs cenv env argsl // REVIEW: fold the next two cases together | Expr.Lambda(_,_ctorThisValOpt,_baseValOpt,argvs,_body,m,rty) -> @@ -81,24 +81,24 @@ let rec accExpr (cenv:cenv) (env:env) expr = accLambdas cenv env topValInfo expr ty | Expr.TyLambda(_,tps,_body,_m,rty) -> let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps,[],ValReprInfo.unnamedRetVal) - accTy cenv env rty; + accTy cenv env rty let ty = tryMkForallTy tps rty accLambdas cenv env topValInfo expr ty | Expr.TyChoose(_tps,e1,_m) -> accExpr cenv env e1 | Expr.Match(_,_exprm,dtree,targets,m,ty) -> - accTy cenv env ty; - accDTree cenv env dtree; - accTargets cenv env m ty targets; + accTy cenv env ty + accDTree cenv env dtree + accTargets cenv env m ty targets | Expr.LetRec (binds,e,_m,_) -> - accBinds cenv env binds; + accBinds cenv env binds accExpr cenv env e | Expr.StaticOptimization (constraints,e2,e3,_m) -> - accExpr cenv env e2; - accExpr cenv env e3; + accExpr cenv env e2 + accExpr cenv env e3 constraints |> List.iter (function | TTyconEqualsTycon(ty1,ty2) -> - accTy cenv env ty1; + accTy cenv env ty1 accTy cenv env ty2 | TTyconIsStruct(ty1) -> accTy cenv env ty1) @@ -106,7 +106,7 @@ let rec accExpr (cenv:cenv) (env:env) expr = and accMethods cenv env baseValOpt l = List.iter (accMethod cenv env baseValOpt) l and accMethod cenv env _baseValOpt (TObjExprMethod(_slotsig,_attribs,_tps,vs,e,_m)) = - vs |> List.iterSquared (accVal cenv env); + vs |> List.iterSquared (accVal cenv env) accExpr cenv env e and accIntfImpls cenv env baseValOpt l = List.iter (accIntfImpl cenv env baseValOpt) l @@ -116,16 +116,16 @@ and accIntfImpl cenv env baseValOpt (ty,overrides) = and accOp cenv env (op,tyargs,args,_m) = // Special cases - accTypeInst cenv env tyargs; - accExprs cenv env args; + accTypeInst cenv env tyargs + accExprs cenv env args match op with // Handle these as special cases since mutables are allowed inside their bodies | TOp.ILCall (_,_,_,_,_,_,_,_,enclTypeArgs,methTypeArgs,tys) -> - accTypeInst cenv env enclTypeArgs; - accTypeInst cenv env methTypeArgs; + accTypeInst cenv env enclTypeArgs + accTypeInst cenv env methTypeArgs accTypeInst cenv env tys | TOp.TraitCall(TTrait(tys,_nm,_,argtys,rty,_sln)) -> - argtys |> accTypeInst cenv env ; + argtys |> accTypeInst cenv env rty |> Option.iter (accTy cenv env) tys |> List.iter (accTy cenv env) @@ -139,11 +139,11 @@ and accLambdas cenv env topValInfo e ety = | Expr.Lambda _ | Expr.TyLambda _ -> let _tps,ctorThisValOpt,baseValOpt,vsl,body,bodyty = destTopLambda cenv.g cenv.amap topValInfo (e, ety) - accTy cenv env bodyty; - vsl |> List.iterSquared (accVal cenv env); - baseValOpt |> Option.iter (accVal cenv env); - ctorThisValOpt |> Option.iter (accVal cenv env); - accExpr cenv env body; + accTy cenv env bodyty + vsl |> List.iterSquared (accVal cenv env) + baseValOpt |> Option.iter (accVal cenv env) + ctorThisValOpt |> Option.iter (accVal cenv env) + accExpr cenv env body | _ -> accExpr cenv env e @@ -151,17 +151,17 @@ and accExprs cenv env exprs = exprs |> List.iter (accExpr cenv env) and accFlatExprs cenv env exprs = exprs |> FlatList.iter (accExpr cenv env) and accTargets cenv env m ty targets = Array.iter (accTarget cenv env m ty) targets -and accTarget cenv env _m _ty (TTarget(_vs,e,_)) = accExpr cenv env e; +and accTarget cenv env _m _ty (TTarget(_vs,e,_)) = accExpr cenv env e and accDTree cenv env x = match x with - | TDSuccess (es,_n) -> accFlatExprs cenv env es; + | TDSuccess (es,_n) -> accFlatExprs cenv env es | TDBind(bind,rest) -> accBind cenv env bind; accDTree cenv env rest | TDSwitch (e,cases,dflt,m) -> accSwitch cenv env (e,cases,dflt,m) and accSwitch cenv env (e,cases,dflt,_m) = - accExpr cenv env e; - cases |> List.iter (fun (TCase(discrim,e)) -> accDiscrim cenv env discrim; accDTree cenv env e) ; + accExpr cenv env e + cases |> List.iter (fun (TCase(discrim,e)) -> accDiscrim cenv env discrim; accDTree cenv env e) dflt |> Option.iter (accDTree cenv env) and accDiscrim cenv env d = @@ -172,31 +172,31 @@ and accDiscrim cenv env d = | Test.IsNull -> () | Test.IsInst (srcty,tgty) -> accTy cenv env srcty; accTy cenv env tgty | Test.ActivePatternCase (exp, tys, _, _, _) -> - accExpr cenv env exp; + accExpr cenv env exp accTypeInst cenv env tys and accAttrib cenv env (Attrib(_,_k,args,props,_,_,_m)) = - args |> List.iter (fun (AttribExpr(e1,_)) -> accExpr cenv env e1); + args |> List.iter (fun (AttribExpr(e1,_)) -> accExpr cenv env e1) props |> List.iter (fun (AttribNamedArg(_nm,_ty,_flg,AttribExpr(expr,_))) -> accExpr cenv env expr) and accAttribs cenv env attribs = List.iter (accAttrib cenv env) attribs and accValReprInfo cenv env (ValReprInfo(_,args,ret)) = - args |> List.iterSquared (accArgReprInfo cenv env); - ret |> accArgReprInfo cenv env; + args |> List.iterSquared (accArgReprInfo cenv env) + ret |> accArgReprInfo cenv env and accArgReprInfo cenv env (argInfo: ArgReprInfo) = accAttribs cenv env argInfo.Attribs and accVal cenv env v = - v.Attribs |> accAttribs cenv env; - v.ValReprInfo |> Option.iter (accValReprInfo cenv env); + v.Attribs |> accAttribs cenv env + v.ValReprInfo |> Option.iter (accValReprInfo cenv env) v.Type |> accTy cenv env and accBind cenv env (bind:Binding) = - accVal cenv env bind.Var; + accVal cenv env bind.Var let topValInfo = match bind.Var.ValReprInfo with Some info -> info | _ -> ValReprInfo.emptyValData - accLambdas cenv env topValInfo bind.Expr bind.Var.Type; + accLambdas cenv env topValInfo bind.Expr bind.Var.Type and accBinds cenv env xs = xs |> FlatList.iter (accBind cenv env) @@ -205,15 +205,15 @@ and accBinds cenv env xs = xs |> FlatList.iter (accBind cenv env) //-------------------------------------------------------------------------- let accTyconRecdField cenv env _tycon (rfield:RecdField) = - accAttribs cenv env rfield.PropertyAttribs; + accAttribs cenv env rfield.PropertyAttribs accAttribs cenv env rfield.FieldAttribs let accTycon cenv env (tycon:Tycon) = - accAttribs cenv env tycon.Attribs; - tycon.AllFieldsArray |> Array.iter (accTyconRecdField cenv env tycon); + accAttribs cenv env tycon.Attribs + tycon.AllFieldsArray |> Array.iter (accTyconRecdField cenv env tycon) if tycon.IsUnionTycon then (* This covers finite unions. *) tycon.UnionCasesAsList |> List.iter (fun uc -> - accAttribs cenv env uc.Attribs; + accAttribs cenv env uc.Attribs uc.RecdFields |> List.iter (accTyconRecdField cenv env tycon)) @@ -232,7 +232,7 @@ and accModuleOrNamespaceDefs cenv env x = List.iter (accModuleOrNamespaceDef cen and accModuleOrNamespaceDef cenv env x = match x with | TMDefRec(_,tycons,mbinds,_m) -> - accTycons cenv env tycons; + accTycons cenv env tycons accModuleOrNamespaceBinds cenv env mbinds | TMDefLet(bind,_m) -> accBind cenv env bind | TMDefDo(e,_m) -> accExpr cenv env e @@ -246,12 +246,12 @@ and accModuleOrNamespaceBind cenv env x = let UnsolvedTyparsOfModuleDef g amap denv (mdef, extraAttribs) = let cenv = - { g =g ; - amap=amap; - denv=denv; + { g =g + amap=amap + denv=denv unsolved = [] } - accModuleOrNamespaceDef cenv Nix mdef; - accAttribs cenv Nix extraAttribs; + accModuleOrNamespaceDef cenv Nix mdef + accAttribs cenv Nix extraAttribs List.rev cenv.unsolved diff --git a/src/fsharp/Fsc/project.json b/src/fsharp/Fsc/project.json index 1a1ee3bbd68..b246aa367ea 100644 --- a/src/fsharp/Fsc/project.json +++ b/src/fsharp/Fsc/project.json @@ -1,17 +1,17 @@ { "dependencies": { - "Microsoft.NETCore.Platforms": "1.0.1-rc2-24027", - "NETStandard.Library": "1.5.0-rc2-24027", - "System.Linq.Expressions": "4.0.11-rc2-24027", - "System.Reflection.Metadata": "1.3.0-rc2-24027", + "Microsoft.NETCore.Platforms": "1.0.1", + "NETStandard.Library": "1.6.0", + "System.Linq.Expressions": "4.1.0", + "System.Reflection.Metadata": "1.4.1-beta-24227-04" }, "runtimes": { "win7-x86": { }, "win7-x64": { }, - "osx.10.10-x64": { }, + "osx.10.11-x64": { }, "ubuntu.14.04-x64": { } }, "frameworks": { - "netstandard1.5": { } + "netstandard1.6": { } } } diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 2c5de389d77..85e07ad0d67 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -124,7 +124,7 @@ let ReportStatistics (oc:TextWriter) = reports oc let NewCounter nm = let count = ref 0 - AddReport (fun oc -> if !count <> 0 then oc.WriteLine (string !count + " " + nm)); + AddReport (fun oc -> if !count <> 0 then oc.WriteLine (string !count + " " + nm)) (fun () -> incr count) let CountClosure = NewCounter "closures" @@ -194,8 +194,8 @@ type cenv = viewCcu: CcuThunk opts: IlxGenOptions /// Cache the generation of the "unit" type - mutable ilUnitTy: ILType option; - amap: Import.ImportMap; + mutable ilUnitTy: ILType option + amap: Import.ImportMap intraAssemblyInfo : IlxGenIntraAssemblyInfo /// Cache methods with SecurityAttribute applied to them, to prevent unnecessary calls to ExistsInEntireHierarchyOfType casApplied : Dictionary } @@ -226,10 +226,10 @@ let useCallVirt cenv boxity (mspec : ILMethodSpec) isBaseCall = /// Referencing other stuff, and descriptions of where items are to be placed /// within the generated IL namespace/typespace. This should be cleaned up. type CompileLocation = - { clocScope: IL.ILScopeRef; - clocTopImplQualifiedName: string; - clocNamespace: string option; - clocEncl: string list; + { clocScope: IL.ILScopeRef + clocTopImplQualifiedName: string + clocNamespace: string option + clocEncl: string list clocQualifiedNameOfFile : string } //-------------------------------------------------------------------------- @@ -239,10 +239,10 @@ type CompileLocation = let mkTopName ns n = String.concat "." (match ns with Some x -> [x;n] | None -> [n]) let CompLocForFragment fragName (ccu:CcuThunk) = - { clocQualifiedNameOfFile =fragName; - clocTopImplQualifiedName= fragName; - clocScope=ccu.ILScopeRef; - clocNamespace=None; + { clocQualifiedNameOfFile =fragName + clocTopImplQualifiedName= fragName + clocScope=ccu.ILScopeRef + clocNamespace=None clocEncl=[]} let CompLocForCcu (ccu:CcuThunk) = CompLocForFragment ccu.AssemblyName ccu @@ -259,10 +259,10 @@ let CompLocForFixedPath fragName qname (CompPath(sref,cpath)) = let ns = textOfPath ns let encl = t |> List.map (fun (s ,_)-> s) let ns = if ns = "" then None else Some ns - { clocQualifiedNameOfFile =fragName; - clocTopImplQualifiedName=qname; - clocScope=sref; - clocNamespace=ns; + { clocQualifiedNameOfFile =fragName + clocTopImplQualifiedName=qname + clocScope=sref + clocNamespace=ns clocEncl=encl } let CompLocForFixedModule fragName qname (mspec:ModuleOrNamespace) = @@ -333,7 +333,7 @@ type TypeReprEnv(reprs : Map, count: int) = member tyenv.Item (tp:Typar, m:range) = try reprs.[tp.Stamp] with :? KeyNotFoundException -> - errorR(InternalError("Undefined or unsolved type variable: " + showL(typarL tp),m)); + errorR(InternalError("Undefined or unsolved type variable: " + showL(typarL tp),m)) // Random value for post-hoc diagnostic analysis on generated tree * uint16 666 @@ -366,7 +366,7 @@ type TypeReprEnv(reprs : Map, count: int) = //-------------------------------------------------------------------------- let GenTyconRef (tcref:TyconRef) = - assert(not tcref.IsTypeAbbrev); + assert(not tcref.IsTypeAbbrev) tcref.CompiledRepresentation type VoidNotOK = VoidNotOK | VoidOK @@ -422,7 +422,7 @@ and GenNamedTyAppAux (amap:Import.ImportMap) m g tyenv ptrsOK tcref tinst = and GenTypeAux amap m g (tyenv: TypeReprEnv) voidOK ptrsOK ty = #if DEBUG - voidCheck m g voidOK ty; + voidCheck m g voidOK ty #else ignore voidOK #endif @@ -457,7 +457,7 @@ and GenUnionCaseRef amap m g tyenv i (fspecs:RecdField array) = and GenUnionRef amap m g (tcref: TyconRef) = let tycon = tcref.Deref - assert(not tycon.IsTypeAbbrev); + assert(not tycon.IsTypeAbbrev) match tycon.UnionTypeInfo with | None -> failwith "GenUnionRef m" | Some funion -> @@ -468,12 +468,13 @@ and GenUnionRef amap m g (tcref: TyconRef) = | CompiledTypeRepr.ILAsmNamed (tref,_,_) -> let alternatives = tycon.UnionCasesArray |> Array.mapi (fun i cspec -> - { altName=cspec.CompiledName; - altCustomAttrs=emptyILCustomAttrs; + { altName=cspec.CompiledName + altCustomAttrs=emptyILCustomAttrs altFields=GenUnionCaseRef amap m g tyenvinner i cspec.RecdFieldsArray }) let nullPermitted = IsUnionTypeWithNullAsTrueValue g tycon let hasHelpers = ComputeUnionHasHelpers g tcref - IlxUnionRef(tref,alternatives,nullPermitted,hasHelpers)) + let boxity = (if tcref.IsStructOrEnumTycon then ILBoxity.AsValue else ILBoxity.AsObject) + IlxUnionRef(boxity, tref,alternatives,nullPermitted,hasHelpers)) and ComputeUnionHasHelpers g (tcref : TyconRef) = if tyconRefEq g tcref g.unit_tcr_canon then NoHelpers @@ -484,7 +485,7 @@ and ComputeUnionHasHelpers g (tcref : TyconRef) = | Some(Attrib(_,_,[ AttribBoolArg (b) ],_,_,_,_)) -> if b then AllHelpers else NoHelpers | Some (Attrib(_,_,_,_,_,_,m)) -> - errorR(Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded(),m)); + errorR(Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded(),m)) AllHelpers | _ -> AllHelpers (* not hiddenRepr *) @@ -572,17 +573,17 @@ type ArityInfo = int list [] type IlxClosureInfo = - { cloExpr: Expr; - cloName: string; - cloArityInfo: ArityInfo; - cloILFormalRetTy: ILType; + { cloExpr: Expr + cloName: string + cloArityInfo: ArityInfo + cloILFormalRetTy: ILType /// An immutable array of free variable descriptions for the closure - cloILFreeVars: IlxClosureFreeVar[]; - cloSpec: IlxClosureSpec; - cloAttribs: Attribs; - cloILGenericParams: IL.ILGenericParameterDefs; - cloFreeVars: Val list; (* nb. the freevars we actually close over *) - ilCloLambdas: IlxClosureLambdas; + cloILFreeVars: IlxClosureFreeVar[] + cloSpec: IlxClosureSpec + cloAttribs: Attribs + cloILGenericParams: IL.ILGenericParameterDefs + cloFreeVars: Val list (* nb. the freevars we actually close over *) + ilCloLambdas: IlxClosureLambdas (* local type func support *) /// The free type parameters occuring in the type of the closure (and not just its body) @@ -595,10 +596,10 @@ type IlxClosureInfo = /// At the callsite we generate /// unbox ty['fv] /// callvirt clo.DirectInvoke - localTypeFuncILGenericArgs: ILType list; - localTypeFuncContractFreeTypars: Typar list; + localTypeFuncILGenericArgs: ILType list + localTypeFuncContractFreeTypars: Typar list localTypeFuncDirectILGenericParams: IL.ILGenericParameterDefs - localTypeFuncInternalFreeTypars: Typar list;} + localTypeFuncInternalFreeTypars: Typar list} //-------------------------------------------------------------------------- @@ -639,8 +640,8 @@ and NamedLocalIlxClosureInfo = | NamedLocalIlxClosureInfoGenerated of IlxClosureInfo and ModuleStorage = - { Vals: Lazy> ; - SubModules: Lazy>; } + { Vals: Lazy> + SubModules: Lazy> } /// BranchCallItems are those where a call to the value can be implemented as /// a branch. At the moment these are only used for generating branch calls back to @@ -664,23 +665,23 @@ and Mark = member x.CodeLabel = (let (Mark(lab)) = x in lab) and IlxGenEnv = - { tyenv: TypeReprEnv; - someTypeInThisAssembly: ILType; - isFinalFile: bool; + { tyenv: TypeReprEnv + someTypeInThisAssembly: ILType + isFinalFile: bool /// Where to place the stuff we're currently generating - cloc: CompileLocation; + cloc: CompileLocation /// Hiding information down the signature chain, used to compute what's public to the assembly - sigToImplRemapInfo: (Remap * SignatureHidingInfo) list; + sigToImplRemapInfo: (Remap * SignatureHidingInfo) list /// All values in scope - valsInScope: ValMap>; + valsInScope: ValMap> /// For optimizing direct tail recusion to a loop - mark says where to branch to. Length is 0 or 1. /// REVIEW: generalize to arbitrary nested local loops?? - innerVals: (ValRef * (BranchCallItem * Mark)) list; + innerVals: (ValRef * (BranchCallItem * Mark)) list /// Full list of enclosing bound values. First non-compiler-generated element is used to help give nice names for closures and other expressions. - letBoundVars: ValRef list; + letBoundVars: ValRef list /// The set of IL local variable indexes currently in use by lexically scoped variables, to allow reuse on different branches. /// Really an integer set. - liveLocals: IntMap; + liveLocals: IntMap /// Are we under the scope of a try, catch or finally? If so we can't tailcall. SEH = structured exception handling withinSEH: bool } @@ -750,7 +751,7 @@ let StorageForVal m v eenv = try eenv.valsInScope.[v] with :? KeyNotFoundException -> assert false - errorR(Error(FSComp.SR.ilUndefinedValue(showL(vspecAtBindL v)),m)); + errorR(Error(FSComp.SR.ilUndefinedValue(showL(vspecAtBindL v)),m)) notlazy (Arg 668(* random value for post-hoc diagnostic analysis on generated tree *) ) v.Force() @@ -771,7 +772,7 @@ let IsValRefIsDllImport g (vref:ValRef) = let GetMethodSpecForMemberVal amap g (memberInfo:ValMemberInfo) (vref:ValRef) = let m = vref.Range let tps,curriedArgInfos,returnTy,retInfo = - assert(vref.ValReprInfo.IsSome); + assert(vref.ValReprInfo.IsSome) GetTopValTypeInCompiledForm g (Option.get vref.ValReprInfo) vref.Type m let tyenvUnderTypars = TypeReprEnv.ForTypars tps let flatArgInfos = List.concat curriedArgInfos @@ -780,7 +781,7 @@ let GetMethodSpecForMemberVal amap g (memberInfo:ValMemberInfo) (vref:ValRef) = let parentTcref = vref.TopValActualParent let parentTypars = parentTcref.TyparsNoRange let numParentTypars = parentTypars.Length - if tps.Length < numParentTypars then error(InternalError("CodeGen check: type checking did not ensure that this method is sufficiently generic", m)); + if tps.Length < numParentTypars then error(InternalError("CodeGen check: type checking did not ensure that this method is sufficiently generic", m)) let ctps,mtps = List.chop numParentTypars tps let isCompiledAsInstance = ValRefIsCompiledAsInstanceMember g vref @@ -807,7 +808,7 @@ let GetMethodSpecForMemberVal amap g (memberInfo:ValMemberInfo) (vref:ValRef) = if not (typeEquiv g (mkTyparTy gtp) ty2) then warning(InternalError("CodeGen check: type checking did not quantify the correct type variables for this method: generalization list contained " + gtp.Name + "#" + string gtp.Stamp + " and list from 'this' pointer contained " + (showL(typeL ty2)), m))) ctps - thisArgTys; + thisArgTys let methodArgTys,paramInfos = List.unzip flatArgInfos let ilMethodArgTys = GenParamTypes amap m g tyenvUnderTypars methodArgTys let ilMethodInst = GenTypeArgs amap m g tyenvUnderTypars (List.map mkTyparTy mtps) @@ -1041,17 +1042,17 @@ let MergeOptions m o1 o2 = | Some x, Some _ -> #if DEBUG // This warning fires on some code that also triggers this warning: - // warning(Error("The implementation of a specified generic interface required a method implementation not fully supported by F# Interactive. In the unlikely event that the resulting class fails to load then compile the interface type into a statically-compiled DLL and reference it using '#r'",m)); + // warning(Error("The implementation of a specified generic interface required a method implementation not fully supported by F# Interactive. In the unlikely event that the resulting class fails to load then compile the interface type into a statically-compiled DLL and reference it using '#r'",m)) // THe code is OK so we don't print this. - errorR(InternalError("MergeOptions: two values given",m)); + errorR(InternalError("MergeOptions: two values given",m)) #else ignore m #endif Some x let MergePropertyPair m (pd: ILPropertyDef) pdef = - {pd with GetMethod=MergeOptions m pd.GetMethod pdef.GetMethod; - SetMethod=MergeOptions m pd.SetMethod pdef.SetMethod;} + {pd with GetMethod=MergeOptions m pd.GetMethod pdef.GetMethod + SetMethod=MergeOptions m pd.SetMethod pdef.SetMethod} type PropKey = PropKey of string * ILTypes * ILThisConvention @@ -1067,7 +1068,7 @@ let AddPropertyDefToHash (m:range) (ht:Dictionary /// Merge a whole group of properties all at once let MergePropertyDefs m ilPropertyDefs = let ht = new Dictionary<_,_>(3,HashIdentity.Structural) - ilPropertyDefs |> List.iter (AddPropertyDefToHash m ht); + ilPropertyDefs |> List.iter (AddPropertyDefToHash m ht) HashRangeSorted ht //-------------------------------------------------------------------------- @@ -1084,10 +1085,10 @@ type TypeDefBuilder(tdef, tdefDiscards) = member b.Close() = { tdef with - Methods = mkILMethods (tdef.Methods.AsList @ ResizeArray.toList gmethods); - Fields = mkILFields (tdef.Fields.AsList @ ResizeArray.toList gfields); - Properties = mkILProperties (tdef.Properties.AsList @ HashRangeSorted gproperties ); - Events = mkILEvents (tdef.Events.AsList @ ResizeArray.toList gevents); + Methods = mkILMethods (tdef.Methods.AsList @ ResizeArray.toList gmethods) + Fields = mkILFields (tdef.Fields.AsList @ ResizeArray.toList gfields) + Properties = mkILProperties (tdef.Properties.AsList @ HashRangeSorted gproperties ) + Events = mkILEvents (tdef.Events.AsList @ ResizeArray.toList gevents) NestedTypes = mkILTypeDefs (tdef.NestedTypes.AsList @ gnested.Close()) } @@ -1168,7 +1169,7 @@ type AssemblyBuilder(cenv:cenv) as mgbuf = let vtref = NestedTypeRefForCompLoc cloc vtdef.Name let vtspec = mkILTySpec(vtref,[]) let vtdef = {vtdef with Access= ComputeTypeAccess vtref true} - mgbuf.AddTypeDef(vtref, vtdef, false, true, None); + mgbuf.AddTypeDef(vtref, vtdef, false, true, None) vtspec), keyComparer=HashIdentity.Structural) @@ -1204,7 +1205,7 @@ type AssemblyBuilder(cenv:cenv) as mgbuf = gtdefs.FindNestedTypeDefsBuilder(tref.Enclosing).AddTypeDef(tdef, eliminateIfEmpty, addAtEnd, tdefDiscards) member mgbuf.GetCurrentFields(tref:ILTypeRef) = - gtdefs.FindNestedTypeDefBuilder(tref).GetCurrentFields(); + gtdefs.FindNestedTypeDefBuilder(tref).GetCurrentFields() member mgbuf.AddReflectedDefinition(vspec : Tast.Val,expr) = // preserve order by storing index of item @@ -1217,7 +1218,7 @@ type AssemblyBuilder(cenv:cenv) as mgbuf = | _ -> () member mgbuf.AddMethodDef(tref:ILTypeRef,ilMethodDef) = - gtdefs.FindNestedTypeDefBuilder(tref).AddMethodDef(ilMethodDef); + gtdefs.FindNestedTypeDefBuilder(tref).AddMethodDef(ilMethodDef) if ilMethodDef.IsEntryPoint then explicitEntryPointInfo <- Some(tref) @@ -1226,9 +1227,9 @@ type AssemblyBuilder(cenv:cenv) as mgbuf = // Doing both a store and load keeps FxCop happier because it thinks the field is useful let instrs = [ yield! (if condition "NO_ADD_FEEFEE_TO_CCTORS" then [] elif condition "ADD_SEQPT_TO_CCTORS" then seqpt else feefee) // mark start of hidden code - yield mkLdcInt32 0; - yield mkNormalStsfld fspec; - yield mkNormalLdsfld fspec; + yield mkLdcInt32 0 + yield mkNormalStsfld fspec + yield mkNormalLdsfld fspec yield AI_pop] gtdefs.FindNestedTypeDefBuilder(tref).PrependInstructionsToSpecificMethodDef(cond,instrs,sourceOpt) @@ -1277,7 +1278,7 @@ type CodeGenBuffer(m:range, alreadyUsedLocals:int, zapFirstSeqPointToStart:bool) = - let locals = new ResizeArray<((string * (Mark * Mark)) list * ILType)>(10) + let locals = new ResizeArray<((string * (Mark * Mark)) list * ILType * bool)>(10) let codebuf = new ResizeArray(200) let exnSpecs = new ResizeArray(10) @@ -1301,12 +1302,12 @@ type CodeGenBuffer(m:range, let mutable lastSeqPoint = None // Add a nop to make way for the first sequence point. There is always such a // sequence point even when zapFirstSeqPointToStart=false - do if mgbuf.cenv.opts.generateDebugSymbols then codebuf.Add(AI_nop); + do if mgbuf.cenv.opts.generateDebugSymbols then codebuf.Add(AI_nop) member cgbuf.DoPushes (pushes: Pushes) = for ty in pushes do - stack <- ty :: stack; - nstack <- nstack + 1; + stack <- ty :: stack + nstack <- nstack + 1 maxStack <- Operators.max maxStack nstack member cgbuf.DoPops (n:Pops) = @@ -1315,9 +1316,9 @@ type CodeGenBuffer(m:range, | [] -> let msg = sprintf "pop on empty stack during code generation, methodName = %s, m = %s" methodName (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) - warning(InternalError(msg,m)); + warning(InternalError(msg,m)) | _ :: t -> - stack <- t; + stack <- t nstack <- nstack - 1 member cgbuf.GetCurrentStack() = stack @@ -1325,17 +1326,17 @@ type CodeGenBuffer(m:range, if nonNil stack then let msg = sprintf "stack flush didn't work, or extraneous expressions left on stack before stack restore, methodName = %s, stack = %+A, m = %s" methodName stack (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) - warning(InternalError(msg,m)); + warning(InternalError(msg,m)) () member cgbuf.EmitInstr(pops,pushes,i) = - cgbuf.DoPops pops; - cgbuf.DoPushes pushes; + cgbuf.DoPops pops + cgbuf.DoPushes pushes codebuf.Add i member cgbuf.EmitInstrs (pops,pushes,is) = - cgbuf.DoPops pops; - cgbuf.DoPushes pushes; + cgbuf.DoPops pops + cgbuf.DoPushes pushes is |> List.iter codebuf.Add member cgbuf.GetLastSequencePoint() = @@ -1349,16 +1350,16 @@ type CodeGenBuffer(m:range, | I_seqpoint sm when sm.Line <> FeeFee mgbuf.cenv -> true | _ -> false)) then - codebuf.Add(AI_nop); + codebuf.Add(AI_nop) member cgbuf.EmitSeqPoint(src) = if mgbuf.cenv.opts.generateDebugSymbols then cgbuf.EnsureNopBetweenDebugPoints() let attr = GenILSourceMarker mgbuf.cenv.g src - assert(isSome(attr)); + assert(isSome(attr)) let i = I_seqpoint (Option.get attr) - codebuf.Add i; + codebuf.Add i // Save the first sequence point away to snap it to the top of the method match seqpoint with | Some _ -> () @@ -1370,7 +1371,7 @@ type CodeGenBuffer(m:range, member cgbuf.EmitStartOfHiddenCode() = if mgbuf.cenv.opts.generateDebugSymbols && not mgbuf.cenv.opts.localOptimizationsAreOn then let doc = mgbuf.cenv.g.memoize_file m.FileIndex - codebuf.Add(FeeFeeInstr mgbuf.cenv doc); + codebuf.Add(FeeFeeInstr mgbuf.cenv doc) member cgbuf.EmitExceptionClause(clause) = exnSpecs.Add clause @@ -1384,7 +1385,7 @@ type CodeGenBuffer(m:range, if codeLabelToCodeLabel.ContainsKey(lab1) then let msg = sprintf "two values given for label %s, methodName = %s, m = %s" (formatCodeLabel lab1) methodName (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) - warning(InternalError(msg,m)); + warning(InternalError(msg,m)) #endif codeLabelToCodeLabel.[lab1] <- lab2 @@ -1393,7 +1394,7 @@ type CodeGenBuffer(m:range, if codeLabelToPC.ContainsKey(lab) then let msg = sprintf "two values given for label %s, methodName = %s, m = %s" (formatCodeLabel lab) methodName (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) - warning(InternalError(msg,m)); + warning(InternalError(msg,m)) #endif codeLabelToPC.[lab] <- pc @@ -1404,32 +1405,32 @@ type CodeGenBuffer(m:range, cgbuf.SetCodeLabelToPC(lab,codebuf.Count) member cgbuf.SetStack(s) = - stack <- s; + stack <- s nstack <- s.Length member cgbuf.Mark(s) = let res = cgbuf.GenerateDelayMark(s) - cgbuf.SetMarkToHere(res); + cgbuf.SetMarkToHere(res) res member cgbuf.mgbuf = mgbuf member cgbuf.MethodName = methodName member cgbuf.PreallocatedArgCount = alreadyUsedArgs - member cgbuf.AllocLocal(ranges,ty) = + member cgbuf.AllocLocal(ranges,ty,isFixed) = let j = locals.Count - locals.Add((ranges,ty)); + locals.Add((ranges,ty,isFixed)) j - member cgbuf.ReallocLocal(cond,ranges,ty) = + member cgbuf.ReallocLocal(cond,ranges,ty,isFixed) = let j = match ResizeArray.tryFindIndexi cond locals with | Some j -> - let (prevRanges,_) = locals.[j] - locals.[j] <- ((ranges@prevRanges),ty); + let (prevRanges,_,isFixed) = locals.[j] + locals.[j] <- ((ranges@prevRanges),ty,isFixed) j | None -> - cgbuf.AllocLocal(ranges,ty) + cgbuf.AllocLocal(ranges,ty,isFixed) let j = j + alreadyUsedLocals j @@ -1487,7 +1488,7 @@ let GenString cenv cgbuf s = let GenConstArray cenv (cgbuf:CodeGenBuffer) eenv ilElementType (data:'a[]) (write : ByteBuffer -> 'a -> unit) = let buf = ByteBuffer.Create data.Length - data |> Array.iter (write buf); + data |> Array.iter (write buf) let bytes = buf.Close() let ilArrayType = mkILArr1DTy ilElementType if data.Length = 0 then @@ -1499,15 +1500,15 @@ let GenConstArray cenv (cgbuf:CodeGenBuffer) eenv ilElementType (data:'a[]) (wri let ilFieldDef = mkILStaticField (ilFieldName,fty, None, Some bytes, ILMemberAccess.Assembly) let ilFieldDef = { ilFieldDef with CustomAttrs = mkILCustomAttrs [ cenv.g.ilg.mkDebuggerBrowsableNeverAttribute() ] } let fspec = mkILFieldSpecInTy (mkILTyForCompLoc eenv.cloc,ilFieldName, fty) - CountStaticFieldDef(); - cgbuf.mgbuf.AddFieldDef(fspec.EnclosingTypeRef,ilFieldDef); + CountStaticFieldDef() + cgbuf.mgbuf.AddFieldDef(fspec.EnclosingTypeRef,ilFieldDef) CG.EmitInstrs cgbuf (pop 0) (Push [ ilArrayType; ilArrayType; cenv.g.ilg.typ_RuntimeFieldHandle ]) - [ mkLdcInt32 data.Length; - I_newarr (ILArrayShape.SingleDimensional,ilElementType); - AI_dup; - I_ldtoken (ILToken.ILField fspec); ] + [ mkLdcInt32 data.Length + I_newarr (ILArrayShape.SingleDimensional,ilElementType) + AI_dup + I_ldtoken (ILToken.ILField fspec) ] CG.EmitInstrs cgbuf (pop 2) Push0 @@ -1553,23 +1554,24 @@ let CodeGenThen cenv mgbuf (zapFirstSeqPointToStart,entryPointInfo,methodName,ee let innerVals = entryPointInfo |> List.map (fun (v,kind) -> (v,(kind,start))) (* Call the given code generator *) - codeGenFunction cgbuf {eenv with withinSEH=false; - liveLocals=IntMap.empty(); - innerVals = innerVals}; + codeGenFunction cgbuf {eenv with withinSEH=false + liveLocals=IntMap.empty() + innerVals = innerVals} let locals,maxStack,lab2pc,code,exnSpecs,hasSequencePoints = cgbuf.Close() let localDebugSpecs : ILLocalDebugInfo list = locals - |> List.mapi (fun i (nms,_) -> List.map (fun nm -> (i,nm)) nms) + |> List.mapi (fun i (nms,_,_isFixed) -> List.map (fun nm -> (i,nm)) nms) |> List.concat |> List.map (fun (i,(nm,(start,finish))) -> - { Range=(start.CodeLabel, finish.CodeLabel); + { Range=(start.CodeLabel, finish.CodeLabel) DebugMappings= [{ LocalIndex=i; LocalName=nm }] }) let ilLocals = locals - |> List.map (fun (infos, ty) -> + |> List.map (fun (infos, ty, isFixed) -> + let loc = // in interactive environment, attach name and range info to locals to improve debug experience if cenv.opts.isInteractive && cenv.opts.generateDebugSymbols then match infos with @@ -1579,7 +1581,8 @@ let CodeGenThen cenv mgbuf (zapFirstSeqPointToStart,entryPointInfo,methodName,ee | [] -> mkILLocal ty None // if not interactive, don't bother adding this info else - mkILLocal ty None) + mkILLocal ty None + if isFixed then { loc with IsPinned=true } else loc) (ilLocals, maxStack, @@ -1619,7 +1622,7 @@ let StartLocalScope nm cgbuf = let LocalScope nm cgbuf (f : (Mark * Mark) -> 'a) : 'a = let _,endScope as scopeMarks = StartLocalScope nm cgbuf let res = f scopeMarks - CG.SetMarkToHere cgbuf endScope; + CG.SetMarkToHere cgbuf endScope res let compileSequenceExpressions = true // try (System.Environment.GetEnvironmentVariable("COMPILED_SEQ") <> null) with _ -> false @@ -1685,7 +1688,7 @@ let rec GenExpr cenv (cgbuf:CodeGenBuffer) eenv sp expr sequel = let expr = stripExpr expr if not (WillGenerateSequencePoint sp expr) && not (AlwaysSuppressSequencePoint sp expr) then - CG.EmitSeqPoint cgbuf expr.Range; + CG.EmitSeqPoint cgbuf expr.Range match (if compileSequenceExpressions then LowerCallsAndSeqs.LowerSeqExpr cenv.g cenv.amap expr else None) with | Some info -> @@ -1707,8 +1710,8 @@ let rec GenExpr cenv (cgbuf:CodeGenBuffer) eenv sp expr sequel = let startScope,endScope as scopeMarks = StartDelayedLocalScope "let" cgbuf let eenv = AllocStorageForBind cenv cgbuf scopeMarks eenv bind let spBind = GenSequencePointForBind cenv cgbuf eenv bind - CG.SetMarkToHere cgbuf startScope; - GenBindAfterSequencePoint cenv cgbuf eenv spBind bind; + CG.SetMarkToHere cgbuf startScope + GenBindAfterSequencePoint cenv cgbuf eenv spBind bind // Work out if we need a sequence point for the body. For any "user" binding then the body gets SPAlways. // For invisible compiler-generated bindings we just use "sp", unless its body is another invisible binding @@ -1754,6 +1757,8 @@ let rec GenExpr cenv (cgbuf:CodeGenBuffer) eenv sp expr sequel = GenGetExnField cenv cgbuf eenv (e,ecref,n,m) sequel | TOp.UnionCaseFieldGet(ucref,n),[e],_ -> GenGetUnionCaseField cenv cgbuf eenv (e,ucref,tyargs,n,m) sequel + | TOp.UnionCaseFieldGetAddr(ucref,n),[e],_ -> + GenGetUnionCaseFieldAddr cenv cgbuf eenv (e,ucref,tyargs,n,m) sequel | TOp.UnionCaseTagGet ucref,[e],_ -> GenGetUnionCaseTag cenv cgbuf eenv (e,ucref,tyargs,m) sequel | TOp.UnionCaseProof ucref,[e],_ -> @@ -1799,13 +1804,13 @@ let rec GenExpr cenv (cgbuf:CodeGenBuffer) eenv sp expr sequel = | TOp.Array,elems,[elemTy] -> GenNewArray cenv cgbuf eenv (elems,elemTy,m) sequel | TOp.Bytes bytes,[],[] -> if cenv.opts.emitConstantArraysUsingStaticDataBlobs then - GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_uint8 bytes (fun buf b -> buf.EmitByte b); + GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_uint8 bytes (fun buf b -> buf.EmitByte b) GenSequel cenv eenv.cloc cgbuf sequel else GenNewArraySimple cenv cgbuf eenv (List.ofArray (Array.map (mkByte cenv.g m) bytes),cenv.g.byte_ty,m) sequel | TOp.UInt16s arr,[],[] -> if cenv.opts.emitConstantArraysUsingStaticDataBlobs then - GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_uint16 arr (fun buf b -> buf.EmitUInt16 b); + GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_uint16 arr (fun buf b -> buf.EmitUInt16 b) GenSequel cenv eenv.cloc cgbuf sequel else GenNewArraySimple cenv cgbuf eenv (List.ofArray (Array.map (mkUInt16 cenv.g m) arr),cenv.g.uint16_ty,m) sequel @@ -1813,7 +1818,7 @@ let rec GenExpr cenv (cgbuf:CodeGenBuffer) eenv sp expr sequel = if cgbuf.mgbuf.cenv.opts.generateDebugSymbols then cgbuf.EmitStartOfHiddenCode() CG.EmitInstr cgbuf (pop 0) Push0 AI_nop - CG.EmitInstr cgbuf (pop 0) Push0 (I_br label); + CG.EmitInstr cgbuf (pop 0) Push0 (I_br label) // NOTE: discard sequel | TOp.Return,[e],_ -> GenExpr cenv cgbuf eenv SPSuppress e Return @@ -1895,7 +1900,7 @@ and GenSequel cenv cloc cgbuf sequel = (match sq with | Continue -> () | DiscardThen sq -> - CG.EmitInstr cgbuf (pop 1) Push0 AI_pop; + CG.EmitInstr cgbuf (pop 1) Push0 AI_pop GenSequel cenv cloc cgbuf sq | ReturnVoid -> CG.EmitInstr cgbuf (pop 0) Push0 I_ret @@ -1916,12 +1921,12 @@ and GenSequel cenv cloc cgbuf sequel = if isFinally then CG.EmitInstr cgbuf (pop 1) Push0 AI_pop else - EmitSetLocal cgbuf whereToSaveResult; + EmitSetLocal cgbuf whereToSaveResult CG.EmitInstr cgbuf (pop 0) Push0 (if isFinally then I_endfinally else I_leave(x.CodeLabel)) | EndFilter -> CG.EmitInstr cgbuf (pop 1) Push0 I_endfilter - ); - GenSequelEndScopes cgbuf sequel; + ) + GenSequelEndScopes cgbuf sequel //-------------------------------------------------------------------------- @@ -1989,11 +1994,11 @@ and GenAllocTuple cenv cgbuf eenv (args,argtys,m) sequel = let ntyvars = if (tys.Length - 1) < goodTupleFields then (tys.Length - 1) else goodTupleFields let formalTyvars = [ for n in 0 .. ntyvars do yield mkILTyvarTy (uint16 n) ] - GenExprs cenv cgbuf eenv args; + GenExprs cenv cgbuf eenv args // Generate a reference to the constructor CG.EmitInstr cgbuf (pop args.Length) (Push [typ]) (mkNormalNewobj - (mkILCtorMethSpecForTy (typ,formalTyvars))); + (mkILCtorMethSpecForTy (typ,formalTyvars))) GenSequel cenv eenv.cloc cgbuf sequel and GenGetTupleField cenv cgbuf eenv (e,tys,n,m) sequel = @@ -2020,20 +2025,20 @@ and GenGetTupleField cenv cgbuf eenv (e,tys,n,m) sequel = and GenAllocExn cenv cgbuf eenv (c,args,m) sequel = - GenExprs cenv cgbuf eenv args; + GenExprs cenv cgbuf eenv args let typ = GenExnType cenv.amap m cenv.g eenv.tyenv c let flds = recdFieldsOfExnDefRef c let argtys = flds |> List.map (fun rfld -> GenType cenv.amap m cenv.g eenv.tyenv rfld.FormalType) let mspec = mkILCtorMethSpecForTy (typ, argtys) CG.EmitInstr cgbuf (pop args.Length) (Push [typ]) - (mkNormalNewobj mspec) ; + (mkNormalNewobj mspec) GenSequel cenv eenv.cloc cgbuf sequel and GenAllocUnionCase cenv cgbuf eenv (c,tyargs,args,m) sequel = - GenExprs cenv cgbuf eenv args; + GenExprs cenv cgbuf eenv args let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv c tyargs - CG.EmitInstrs cgbuf (pop args.Length) (Push [cuspec.EnclosingType]) (EraseUnions.mkNewData cenv.g.ilg (cuspec, idx)); + CG.EmitInstrs cgbuf (pop args.Length) (Push [cuspec.EnclosingType]) (EraseUnions.mkNewData cenv.g.ilg (cuspec, idx)) GenSequel cenv eenv.cloc cgbuf sequel and GenAllocRecd cenv cgbuf eenv ctorInfo (tcref,argtys,args,m) sequel = @@ -2048,19 +2053,19 @@ and GenAllocRecd cenv cgbuf eenv ctorInfo (tcref,argtys,args,m) sequel = match ctorInfo with | RecdExprIsObjInit -> (args,relevantFields) ||> List.iter2 (fun e f -> - CG.EmitInstr cgbuf (pop 0) (Push (if tcref.IsStructOrEnumTycon then [ILType.Byref typ] else [typ])) mkLdarg0; - GenExpr cenv cgbuf eenv SPSuppress e Continue; + CG.EmitInstr cgbuf (pop 0) (Push (if tcref.IsStructOrEnumTycon then [ILType.Byref typ] else [typ])) mkLdarg0 + GenExpr cenv cgbuf eenv SPSuppress e Continue GenFieldStore false cenv cgbuf eenv (tcref.MakeNestedRecdFieldRef f,argtys,m) discard) // Object construction doesn't generate a true value. // Object constructions will always just get thrown away so this is safe GenSequel cenv eenv.cloc cgbuf sequel | RecdExpr -> - GenExprs cenv cgbuf eenv args; + GenExprs cenv cgbuf eenv args // generate a reference to the record constructor let tyenvinner = TypeReprEnv.ForTyconRef tcref CG.EmitInstr cgbuf (pop args.Length) (Push [typ]) (mkNormalNewobj - (mkILCtorMethSpecForTy (typ,relevantFields |> List.map (fun f -> GenType cenv.amap m cenv.g tyenvinner f.FormalType) ))); + (mkILCtorMethSpecForTy (typ,relevantFields |> List.map (fun f -> GenType cenv.amap m cenv.g tyenvinner f.FormalType) ))) GenSequel cenv eenv.cloc cgbuf sequel @@ -2068,10 +2073,10 @@ and GenNewArraySimple cenv cgbuf eenv (elems,elemTy,m) sequel = let ilElemTy = GenType cenv.amap m cenv.g eenv.tyenv elemTy let ilArrTy = mkILArr1DTy ilElemTy - CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy]) [ (AI_ldc (DT_I4,ILConst.I4 (elems.Length))); I_newarr (ILArrayShape.SingleDimensional,ilElemTy) ]; + CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy]) [ (AI_ldc (DT_I4,ILConst.I4 (elems.Length))); I_newarr (ILArrayShape.SingleDimensional,ilElemTy) ] elems |> List.iteri (fun i e -> - CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy; cenv.g.ilg.typ_int32]) [ AI_dup; (AI_ldc (DT_I4,ILConst.I4 i)) ]; - GenExpr cenv cgbuf eenv SPSuppress e Continue; + CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy; cenv.g.ilg.typ_int32]) [ AI_dup; (AI_ldc (DT_I4,ILConst.I4 i)) ] + GenExpr cenv cgbuf eenv SPSuppress e Continue CG.EmitInstr cgbuf (pop 3) Push0 (I_stelem_any (ILArrayShape.SingleDimensional,ilElemTy))) GenSequel cenv eenv.cloc cgbuf sequel @@ -2103,7 +2108,7 @@ and GenNewArray cenv cgbuf eenv (elems: Expr list,elemTy,m) sequel = if elems' |> Array.forall (function Expr.Const(c,_,_) -> test c | _ -> false) then let ilElemTy = GenType cenv.amap m cenv.g eenv.tyenv elemTy - GenConstArray cenv cgbuf eenv ilElemTy elems' (fun buf -> function Expr.Const(c,_,_) -> write buf c | _ -> failwith "unreachable"); + GenConstArray cenv cgbuf eenv ilElemTy elems' (fun buf -> function Expr.Const(c,_,_) -> write buf c | _ -> failwith "unreachable") GenSequel cenv eenv.cloc cgbuf sequel else @@ -2118,38 +2123,38 @@ and GenCoerce cenv cgbuf eenv (e,tgty,m,srcty) sequel = // The .NET IL doesn't always support implict subsumption for interface types, e.g. at stack merge points // Hence be conservative here and always cast explicitly. if (isInterfaceTy cenv.g tgty) then ( - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let ilToTy = GenType cenv.amap m cenv.g eenv.tyenv tgty - CG.EmitInstrs cgbuf (pop 1) (Push [ilToTy]) [ I_unbox_any ilToTy; ]; + CG.EmitInstrs cgbuf (pop 1) (Push [ilToTy]) [ I_unbox_any ilToTy ] GenSequel cenv eenv.cloc cgbuf sequel ) else ( - GenExpr cenv cgbuf eenv SPSuppress e sequel; + GenExpr cenv cgbuf eenv SPSuppress e sequel ) end else - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue if not (isObjTy cenv.g srcty) then let ilFromTy = GenType cenv.amap m cenv.g eenv.tyenv srcty - CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Object]) [ I_box ilFromTy; ]; + CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Object]) [ I_box ilFromTy ] if not (isObjTy cenv.g tgty) then let ilToTy = GenType cenv.amap m cenv.g eenv.tyenv tgty - CG.EmitInstrs cgbuf (pop 1) (Push [ilToTy]) [ I_unbox_any ilToTy; ]; + CG.EmitInstrs cgbuf (pop 1) (Push [ilToTy]) [ I_unbox_any ilToTy ] GenSequel cenv eenv.cloc cgbuf sequel and GenReraise cenv cgbuf eenv (rtnty,m) sequel = let ilReturnTy = GenType cenv.amap m cenv.g eenv.tyenv rtnty - CG.EmitInstrs cgbuf (pop 0) Push0 [I_rethrow]; + CG.EmitInstrs cgbuf (pop 0) Push0 [I_rethrow] // [See comment related to I_throw]. // Rethrow does not return. Required to push dummy value on the stack. // This follows prior behaviour by prim-types reraise<_>. - CG.EmitInstrs cgbuf (pop 0) (Push [ilReturnTy]) [AI_ldnull; I_unbox_any ilReturnTy ]; + CG.EmitInstrs cgbuf (pop 0) (Push [ilReturnTy]) [AI_ldnull; I_unbox_any ilReturnTy ] GenSequel cenv eenv.cloc cgbuf sequel and GenGetExnField cenv cgbuf eenv (e,ecref,fieldNum,m) sequel = - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let exnc = stripExnEqns ecref let typ = GenExnType cenv.amap m cenv.g eenv.tyenv ecref - CG.EmitInstrs cgbuf (pop 0) Push0 [ I_castclass typ]; + CG.EmitInstrs cgbuf (pop 0) Push0 [ I_castclass typ] let fld = List.item fieldNum exnc.TrueInstanceFieldsAsList let ftyp = GenType cenv.amap m cenv.g eenv.tyenv fld.FormalType @@ -2160,46 +2165,57 @@ and GenGetExnField cenv cgbuf eenv (e,ecref,fieldNum,m) sequel = GenSequel cenv eenv.cloc cgbuf sequel and GenSetExnField cenv cgbuf eenv (e,ecref,fieldNum,e2,m) sequel = - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let exnc = stripExnEqns ecref let typ = GenExnType cenv.amap m cenv.g eenv.tyenv ecref - CG.EmitInstrs cgbuf (pop 0) Push0 [ I_castclass typ ]; + CG.EmitInstrs cgbuf (pop 0) Push0 [ I_castclass typ ] let fld = List.item fieldNum exnc.TrueInstanceFieldsAsList let ftyp = GenType cenv.amap m cenv.g eenv.tyenv fld.FormalType let ilFieldName = ComputeFieldName exnc fld - GenExpr cenv cgbuf eenv SPSuppress e2 Continue; - CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld(mkILFieldSpecInTy (typ,ilFieldName,ftyp))); + GenExpr cenv cgbuf eenv SPSuppress e2 Continue + CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld(mkILFieldSpecInTy (typ,ilFieldName,ftyp))) GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel and UnionCodeGen (cgbuf: CodeGenBuffer) = { new EraseUnions.ICodeGen with member __.CodeLabel(m) = m.CodeLabel member __.GenerateDelayMark() = CG.GenerateDelayMark cgbuf "unionCodeGenMark" - member __.GenLocal(ilty) = cgbuf.AllocLocal([],ilty) |> uint16 + member __.GenLocal(ilty) = cgbuf.AllocLocal([],ilty,false) |> uint16 member __.SetMarkToHere(m) = CG.SetMarkToHere cgbuf m member __.EmitInstr x = CG.EmitInstr cgbuf (pop 0) (Push []) x member __.EmitInstrs xs = CG.EmitInstrs cgbuf (pop 0) (Push []) xs } and GenUnionCaseProof cenv cgbuf eenv (e,ucref,tyargs,m) sequel = - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv ucref tyargs let fty = EraseUnions.GetILTypeForAlternative cuspec idx - EraseUnions.emitCastData cenv.g.ilg (UnionCodeGen cgbuf) (false,cuspec,idx) + let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef + EraseUnions.emitCastData cenv.g.ilg (UnionCodeGen cgbuf) (false,avoidHelpers,cuspec,idx) CG.EmitInstrs cgbuf (pop 1) (Push [fty]) [ ] // push/pop to match the line above GenSequel cenv eenv.cloc cgbuf sequel and GenGetUnionCaseField cenv cgbuf eenv (e,ucref,tyargs,n,m) sequel = - assert (isProvenUnionCaseTy (tyOfExpr cenv.g e)); + assert (ucref.Tycon.IsStructOrEnumTycon || isProvenUnionCaseTy (tyOfExpr cenv.g e)) - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv ucref tyargs let fty = actualTypOfIlxUnionField cuspec idx n let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef - CG.EmitInstrs cgbuf (pop 1) (Push [fty]) (EraseUnions.mkLdData (avoidHelpers, cuspec, idx, n)); + CG.EmitInstrs cgbuf (pop 1) (Push [fty]) (EraseUnions.mkLdData (avoidHelpers, cuspec, idx, n)) + GenSequel cenv eenv.cloc cgbuf sequel + +and GenGetUnionCaseFieldAddr cenv cgbuf eenv (e,ucref,tyargs,n,m) sequel = + assert (ucref.Tycon.IsStructOrEnumTycon || isProvenUnionCaseTy (tyOfExpr cenv.g e)) + + GenExpr cenv cgbuf eenv SPSuppress e Continue + let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv ucref tyargs + let fty = actualTypOfIlxUnionField cuspec idx n + let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef + CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fty]) (EraseUnions.mkLdDataAddr (avoidHelpers, cuspec, idx, n)) GenSequel cenv eenv.cloc cgbuf sequel and GenGetUnionCaseTag cenv cgbuf eenv (e,tcref,tyargs,m) sequel = - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let cuspec = GenUnionSpec cenv.amap m cenv.g eenv.tyenv tcref tyargs let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib tcref EraseUnions.emitLdDataTag cenv.g.ilg (UnionCodeGen cgbuf) (avoidHelpers, cuspec) @@ -2207,41 +2223,42 @@ and GenGetUnionCaseTag cenv cgbuf eenv (e,tcref,tyargs,m) sequel = GenSequel cenv eenv.cloc cgbuf sequel and GenSetUnionCaseField cenv cgbuf eenv (e,ucref,tyargs,n,e2,m) sequel = - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv ucref tyargs - EraseUnions.emitCastData cenv.g.ilg (UnionCodeGen cgbuf) (false,cuspec,idx) + let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef + EraseUnions.emitCastData cenv.g.ilg (UnionCodeGen cgbuf) (false,avoidHelpers,cuspec,idx) CG.EmitInstrs cgbuf (pop 1) (Push [cuspec.EnclosingType]) [ ] // push/pop to match the line above - GenExpr cenv cgbuf eenv SPSuppress e2 Continue; - CG.EmitInstrs cgbuf (pop 2) Push0 (EraseUnions.mkStData (cuspec, idx, n)); + GenExpr cenv cgbuf eenv SPSuppress e2 Continue + CG.EmitInstrs cgbuf (pop 2) Push0 (EraseUnions.mkStData (cuspec, idx, n)) GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel and GenGetRecdFieldAddr cenv cgbuf eenv (e,f,tyargs,m) sequel = - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let fref = GenRecdFieldRef m cenv eenv.tyenv f tyargs - CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fref.ActualType]) [ I_ldflda fref ] ; + CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fref.ActualType]) [ I_ldflda fref ] GenSequel cenv eenv.cloc cgbuf sequel and GenGetStaticFieldAddr cenv cgbuf eenv (f,tyargs,m) sequel = let fspec = GenRecdFieldRef m cenv eenv.tyenv f tyargs - CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref fspec.ActualType]) [ I_ldsflda fspec ] ; + CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref fspec.ActualType]) [ I_ldsflda fspec ] GenSequel cenv eenv.cloc cgbuf sequel and GenGetRecdField cenv cgbuf eenv (e,f,tyargs,m) sequel = - GenExpr cenv cgbuf eenv SPSuppress e Continue; - GenFieldGet false cenv cgbuf eenv (f,tyargs,m); + GenExpr cenv cgbuf eenv SPSuppress e Continue + GenFieldGet false cenv cgbuf eenv (f,tyargs,m) GenSequel cenv eenv.cloc cgbuf sequel and GenSetRecdField cenv cgbuf eenv (e1,f,tyargs,e2,m) sequel = - GenExpr cenv cgbuf eenv SPSuppress e1 Continue; - GenExpr cenv cgbuf eenv SPSuppress e2 Continue; + GenExpr cenv cgbuf eenv SPSuppress e1 Continue + GenExpr cenv cgbuf eenv SPSuppress e2 Continue GenFieldStore false cenv cgbuf eenv (f,tyargs,m) sequel and GenGetStaticField cenv cgbuf eenv (f,tyargs,m) sequel = - GenFieldGet true cenv cgbuf eenv (f,tyargs,m); + GenFieldGet true cenv cgbuf eenv (f,tyargs,m) GenSequel cenv eenv.cloc cgbuf sequel and GenSetStaticField cenv cgbuf eenv (f,tyargs,e2,m) sequel = - GenExpr cenv cgbuf eenv SPSuppress e2 Continue; + GenExpr cenv cgbuf eenv SPSuppress e2 Continue GenFieldStore true cenv cgbuf eenv (f,tyargs,m) sequel and mk_field_pops isStatic n = if isStatic then pop n else pop (n+1) @@ -2268,7 +2285,7 @@ and GenFieldStore isStatic cenv cgbuf eenv (rfref:RecdFieldRef,tyargs,m) sequel else let vol = if rfref.RecdField.IsVolatile then Volatile else Nonvolatile let instr = if isStatic then I_stsfld (vol, fspec) else I_stfld (ILAlignment.Aligned, vol, fspec) - CG.EmitInstr cgbuf (mk_field_pops isStatic 1) Push0 instr; + CG.EmitInstr cgbuf (mk_field_pops isStatic 1) Push0 instr GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel //-------------------------------------------------------------------------- @@ -2287,7 +2304,7 @@ and GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInf // obj.M() | [[_];[]],[arg1;arg2] when numObjArgs = 1 -> assert isUnitTy cenv.g (tyOfExpr cenv.g arg2) - GenExpr cenv cgbuf eenv SPSuppress arg1 Continue; + GenExpr cenv cgbuf eenv SPSuppress arg1 Continue GenExpr cenv cgbuf eenv SPSuppress arg2 discard | _ -> (curriedArgInfos,args) ||> List.iter2 (fun argInfos x -> @@ -2301,8 +2318,8 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr sequel = GenExpr cenv cgbuf eenv SPSuppress expr sequel elif isTupleExpr expr then let es = tryDestTuple expr - if es.Length <> numRequiredExprs then error(InternalError("GenUntupledArgExpr (2)",m)); - es |> List.iter (fun x -> GenExpr cenv cgbuf eenv SPSuppress x Continue); + if es.Length <> numRequiredExprs then error(InternalError("GenUntupledArgExpr (2)",m)) + es |> List.iter (fun x -> GenExpr cenv cgbuf eenv SPSuppress x Continue) GenSequel cenv eenv.cloc cgbuf sequel else let ty = tyOfExpr cenv.g expr @@ -2310,10 +2327,10 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr sequel = let bind = mkCompGenBind locv expr LocalScope "untuple" cgbuf (fun scopeMarks -> let eenvinner = AllocStorageForBind cenv cgbuf scopeMarks eenv bind - GenBind cenv cgbuf eenvinner bind; + GenBind cenv cgbuf eenvinner bind let tys = destTupleTy cenv.g ty assert (tys.Length = numRequiredExprs) - argInfos |> List.iteri (fun i _ -> GenGetTupleField cenv cgbuf eenvinner (loce,tys,i,m) Continue); + argInfos |> List.iteri (fun i _ -> GenGetTupleField cenv cgbuf eenvinner (loce,tys,i,m) Continue) GenSequel cenv eenv.cloc cgbuf sequel ) @@ -2350,13 +2367,13 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = match kind with | BranchCallClosure arityInfo -> let ntmargs = List.foldBack (+) arityInfo 0 - GenExprs cenv cgbuf eenv args; + GenExprs cenv cgbuf eenv args ntmargs | BranchCallMethod (arityInfo,curriedArgInfos,_,ntmargs,numObjArgs) -> assert (curriedArgInfos.Length = arityInfo.Length ) assert (curriedArgInfos.Length = args.Length) //assert (curriedArgInfos.Length = ntmargs ) - GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInfos args; + GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInfos args if v.IsExtensionMember then match curriedArgInfos, args with | [[]],[_] when numObjArgs = 0 -> (ntmargs-1) @@ -2378,9 +2395,9 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = (valRefEq cenv.g v cenv.g.reference_equality_inner_vref) && isAppTy cenv.g ty -> - GenExpr cenv cgbuf eenv SPSuppress arg1 Continue; - GenExpr cenv cgbuf eenv SPSuppress arg2 Continue; - CG.EmitInstr cgbuf (pop 2) (Push [cenv.g.ilg.typ_bool]) AI_ceq; + GenExpr cenv cgbuf eenv SPSuppress arg1 Continue + GenExpr cenv cgbuf eenv SPSuppress arg2 Continue + CG.EmitInstr cgbuf (pop 2) (Push [cenv.g.ilg.typ_bool]) AI_ceq GenSequel cenv eenv.cloc cgbuf sequel // Emit "methodhandleof" calls as ldtoken instructions @@ -2397,7 +2414,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let storage = StorageForValRef m vref eenv match storage with | Method (_,_,mspec,_,_,_) -> - CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_RuntimeMethodHandle]) (I_ldtoken (ILToken.ILMethod mspec)); + CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_RuntimeMethodHandle]) (I_ldtoken (ILToken.ILMethod mspec)) | _ -> errorR(Error(FSComp.SR.ilxgenUnexpectedArgumentToMethodHandleOfDuringCodegen(), m)) @@ -2408,7 +2425,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let boxity = (if valu then AsValue else AsObject) let mkFormalParams gparams = gparams |> DropErasedTyargs |> List.mapi (fun n _gf -> mkILTyvarTy (uint16 n)) let ilGenericMethodSpec = IL.mkILMethSpec (ilMethRef, boxity, mkFormalParams actualTypeInst, mkFormalParams actualMethInst) - let i = I_ldtoken (ILToken.ILMethod ilGenericMethodSpec); + let i = I_ldtoken (ILToken.ILMethod ilGenericMethodSpec) CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_RuntimeMethodHandle]) i | _ -> @@ -2455,7 +2472,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = | _ -> 0 let (ilEnclArgTys,ilMethArgTys) = - if ilTyArgs.Length < numEnclILTypeArgs then error(InternalError("length mismatch",m)); + if ilTyArgs.Length < numEnclILTypeArgs then error(InternalError("length mismatch",m)) List.chop numEnclILTypeArgs ilTyArgs let boxity = mspec.EnclosingType.Boxity @@ -2493,9 +2510,9 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = // ok, now we're ready to generate if isSuperInit || isSelfInit then - CG.EmitInstrs cgbuf (pop 0) (Push [mspec.EnclosingType ]) [ mkLdarg0 ] ; + CG.EmitInstrs cgbuf (pop 0) (Push [mspec.EnclosingType ]) [ mkLdarg0 ] - GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m vref.NumObjArgs curriedArgInfos nowArgs; + GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m vref.NumObjArgs curriedArgInfos nowArgs // Generate laterArgs (for effects) and save LocalScope "callstack" cgbuf (fun scopeMarks -> @@ -2504,7 +2521,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = // Only save arguments that have effects if Optimizer.ExprHasEffect cenv.g laterArg then let ilTy = laterArg |> tyOfExpr cenv.g |> GenType cenv.amap m cenv.g eenv.tyenv - let loc,eenv = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("arg",m), ilTy) scopeMarks + let loc,eenv = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("arg",m), ilTy, false) scopeMarks GenExpr cenv cgbuf eenv SPSuppress laterArg Continue EmitSetLocal cgbuf loc Choice1Of2 (ilTy,loc),eenv @@ -2513,10 +2530,10 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let nargs = mspec.FormalArgTypes.Length CG.EmitInstr cgbuf (pop (nargs + (if mspec.CallingConv.IsStatic || newobj then 0 else 1))) - (if mustGenerateUnitAfterCall || isSuperInit || isSelfInit then Push0 else (Push [(GenType cenv.amap m cenv.g eenv.tyenv actualRetTy)])) callInstr; + (if mustGenerateUnitAfterCall || isSuperInit || isSelfInit then Push0 else (Push [(GenType cenv.amap m cenv.g eenv.tyenv actualRetTy)])) callInstr // For isSuperInit, load the 'this' pointer as the pretend 'result' of the operation. It will be popped again in most cases - if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [mspec.EnclosingType]) [ mkLdarg0 ] ; + if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [mspec.EnclosingType]) [ mkLdarg0 ] // When generating debug code, generate a 'nop' after a 'call' that returns 'void' // This is what C# does, as it allows the call location to be maintained correctly in the stack frame @@ -2545,7 +2562,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = | _ -> (* worst case: generate a first-class function value and call *) - GenExpr cenv cgbuf eenv SPSuppress f Continue; + GenExpr cenv cgbuf eenv SPSuppress f Continue GenArgsAndIndirectCall cenv cgbuf eenv (fty,tyargs,args,m) sequel and CanTailcall (hasStructObjArg, ccallInfo, withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, isSelfInit, makesNoCriticalTailcalls, sequel) = @@ -2575,17 +2592,17 @@ and GenNamedLocalTyFuncCall cenv (cgbuf: CodeGenBuffer) eenv typ cloinfo tyargs let ilContractTy = mkILBoxedTy ilContractCloTySpec.TypeRef ilContractClassTyargs - if not (ilContractMethTyargs.Length = ilTyArgs.Length) then errorR(Error(FSComp.SR.ilIncorrectNumberOfTypeArguments(),m)); + if not (ilContractMethTyargs.Length = ilTyArgs.Length) then errorR(Error(FSComp.SR.ilIncorrectNumberOfTypeArguments(),m)) // Local TyFunc are represented as a $contract type. they currently get stored in a value of type object // Recover result (value or reference types) via unbox_any. - CG.EmitInstrs cgbuf (pop 1) (Push [ilContractTy]) [I_unbox_any ilContractTy]; + CG.EmitInstrs cgbuf (pop 1) (Push [ilContractTy]) [I_unbox_any ilContractTy] let actualRetTy = applyTys cenv.g typ (tyargs,[]) let ilDirectInvokeMethSpec = mkILInstanceMethSpecInTy(ilContractTy, "DirectInvoke", [], ilContractFormalRetTy, ilTyArgs) let ilActualRetTy = GenType cenv.amap m cenv.g eenv.tyenv actualRetTy - CountCallFuncInstructions(); - CG.EmitInstr cgbuf (pop 1) (Push [ilActualRetTy]) (mkNormalCallvirt ilDirectInvokeMethSpec); + CountCallFuncInstructions() + CG.EmitInstr cgbuf (pop 1) (Push [ilActualRetTy]) (mkNormalCallvirt ilDirectInvokeMethSpec) actualRetTy @@ -2593,7 +2610,7 @@ and GenNamedLocalTyFuncCall cenv (cgbuf: CodeGenBuffer) eenv typ cloinfo tyargs and GenArgsAndIndirectCall cenv cgbuf eenv (functy,tyargs,args,m) sequel = // Generate the arguments to the indirect call - GenExprs cenv cgbuf eenv args; + GenExprs cenv cgbuf eenv args GenIndirectCall cenv cgbuf eenv (functy,tyargs,args,m) sequel /// Generate an indirect call, converting to an ILX callfunc instruction @@ -2634,11 +2651,11 @@ and GenIndirectCall cenv cgbuf eenv (functy,tyargs,args,m) sequel = check ilxClosureApps let isTailCall = CanTailcall(false,None,eenv.withinSEH,hasByrefArg,false,false,false,false,sequel) - CountCallFuncInstructions(); + CountCallFuncInstructions() // Generate the code code an ILX callfunc operation - let instrs = EraseClosures.mkCallFunc cenv.g.ilxPubCloEnv (fun ty -> cgbuf.AllocLocal([], ty) |> uint16) eenv.tyenv.Count isTailCall ilxClosureApps - CG.EmitInstrs cgbuf (pop (1+args.Length)) (Push [ilActualRetTy]) instrs; + let instrs = EraseClosures.mkCallFunc cenv.g.ilxPubCloEnv (fun ty -> cgbuf.AllocLocal([], ty,false) |> uint16) eenv.tyenv.Count isTailCall ilxClosureApps + CG.EmitInstrs cgbuf (pop (1+args.Length)) (Push [ilActualRetTy]) instrs // Done compiling indirect call... GenSequel cenv eenv.cloc cgbuf sequel @@ -2660,14 +2677,14 @@ and GenTry cenv cgbuf eenv scopeMarks (e1,m,resty,spTry) = let afterHandler = CG.GenerateDelayMark cgbuf "afterHandler" let eenvinner = {eenvinner with withinSEH = true} let ilResultTy = GenType cenv.amap m cenv.g eenvinner.tyenv resty - let whereToSave,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("tryres",m),ilResultTy) (startTryMark,endTryMark) + let whereToSave,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("tryres",m),ilResultTy, false) (startTryMark,endTryMark) // Generate the body of the try. In the normal case (SequencePointAtTry) we generate a sequence point // both on the 'try' keyword and on the start of the expression in the 'try'. For inlined code and // compiler generated 'try' blocks (i.e. NoSequencePointAtTry, used for the try/finally implicit // in a 'use' or 'foreach'), we suppress the sequence point - GenExpr cenv cgbuf eenvinner sp e1 (LeaveHandler (false, whereToSave,afterHandler)); - CG.SetMarkToHere cgbuf endTryMark; + GenExpr cenv cgbuf eenvinner sp e1 (LeaveHandler (false, whereToSave,afterHandler)) + CG.SetMarkToHere cgbuf endTryMark let tryMarks = (startTryMark.CodeLabel, endTryMark.CodeLabel) whereToSave,eenvinner,stack,tryMarks,afterHandler,ilResultTy @@ -2699,32 +2716,32 @@ and GenTryCatch cenv cgbuf eenv (e1,vf:Val,ef,vh:Val,eh,m,resty,spTry,spWith) se | NoSequencePointAtWith -> () - CG.SetStack cgbuf [cenv.g.ilg.typ_Object]; + CG.SetStack cgbuf [cenv.g.ilg.typ_Object] let _,eenvinner = AllocLocalVal cenv cgbuf vf eenvinner None (startOfFilter,afterFilter) - CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Exception]) (I_castclass cenv.g.ilg.typ_Exception); + CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Exception]) (I_castclass cenv.g.ilg.typ_Exception) - GenStoreVal cgbuf eenvinner vf.Range vf; + GenStoreVal cgbuf eenvinner vf.Range vf // Why SPSuppress? Because we do not emit a sequence point at the start of the List.filter - we've already put one on // the 'with' keyword above - GenExpr cenv cgbuf eenvinner SPSuppress ef sequelOnBranches; - CG.SetMarkToHere cgbuf afterJoin; - CG.SetStack cgbuf stackAfterJoin; - GenSequel cenv eenv.cloc cgbuf sequelAfterJoin; - end; + GenExpr cenv cgbuf eenvinner SPSuppress ef sequelOnBranches + CG.SetMarkToHere cgbuf afterJoin + CG.SetStack cgbuf stackAfterJoin + GenSequel cenv eenv.cloc cgbuf sequelAfterJoin + end let endOfFilter = CG.GenerateMark cgbuf "endOfFilter" let filterMarks = (startOfFilter.CodeLabel, endOfFilter.CodeLabel) - CG.SetMarkToHere cgbuf afterFilter; + CG.SetMarkToHere cgbuf afterFilter let startOfHandler = CG.GenerateMark cgbuf "startOfHandler" begin - CG.SetStack cgbuf [cenv.g.ilg.typ_Object]; + CG.SetStack cgbuf [cenv.g.ilg.typ_Object] let _,eenvinner = AllocLocalVal cenv cgbuf vh eenvinner None (startOfHandler,afterHandler) - CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Exception]) (I_castclass cenv.g.ilg.typ_Exception); - GenStoreVal cgbuf eenvinner vh.Range vh; + CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Exception]) (I_castclass cenv.g.ilg.typ_Exception) + GenStoreVal cgbuf eenvinner vh.Range vh - GenExpr cenv cgbuf eenvinner SPAlways eh (LeaveHandler (false, whereToSave,afterHandler)); - end; + GenExpr cenv cgbuf eenvinner SPAlways eh (LeaveHandler (false, whereToSave,afterHandler)) + end let endOfHandler = CG.GenerateMark cgbuf "endOfHandler" let handlerMarks = (startOfHandler.CodeLabel, endOfHandler.CodeLabel) ILExceptionClause.FilterCatch(filterMarks, handlerMarks) @@ -2735,31 +2752,31 @@ and GenTryCatch cenv cgbuf eenv (e1,vf:Val,ef,vh:Val,eh,m,resty,spTry,spWith) se | SequencePointAtWith m -> CG.EmitSeqPoint cgbuf m | NoSequencePointAtWith -> () - CG.SetStack cgbuf [cenv.g.ilg.typ_Object]; + CG.SetStack cgbuf [cenv.g.ilg.typ_Object] let _,eenvinner = AllocLocalVal cenv cgbuf vh eenvinner None (startOfHandler,afterHandler) - CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Exception]) (I_castclass cenv.g.ilg.typ_Exception); + CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Exception]) (I_castclass cenv.g.ilg.typ_Exception) - GenStoreVal cgbuf eenvinner m vh; + GenStoreVal cgbuf eenvinner m vh - GenExpr cenv cgbuf eenvinner SPAlways eh (LeaveHandler (false, whereToSave,afterHandler)); - end; + GenExpr cenv cgbuf eenvinner SPAlways eh (LeaveHandler (false, whereToSave,afterHandler)) + end let endOfHandler = CG.GenerateMark cgbuf "endOfHandler" let handlerMarks = (startOfHandler.CodeLabel, endOfHandler.CodeLabel) ILExceptionClause.TypeCatch(cenv.g.ilg.typ_Object, handlerMarks) cgbuf.EmitExceptionClause - { Clause = seh; - Range= tryMarks } ; + { Clause = seh + Range= tryMarks } - CG.SetMarkToHere cgbuf afterHandler; - CG.SetStack cgbuf []; + CG.SetMarkToHere cgbuf afterHandler + CG.SetStack cgbuf [] - cgbuf.EmitStartOfHiddenCode(); + cgbuf.EmitStartOfHiddenCode() (* Restore the stack and load the result *) - EmitRestoreStack cgbuf stack; (* RESTORE *) + EmitRestoreStack cgbuf stack (* RESTORE *) - EmitGetLocal cgbuf ilResultTy whereToSave; + EmitGetLocal cgbuf ilResultTy whereToSave GenSequel cenv eenv.cloc cgbuf sequel ) @@ -2773,14 +2790,14 @@ and GenTryFinally cenv cgbuf eenv (bodyExpr,handlerExpr,m,resty,spTry,spFinally) // Now the catch/finally block let startOfHandler = CG.GenerateMark cgbuf "startOfHandler" - CG.SetStack cgbuf []; + CG.SetStack cgbuf [] let sp = match spFinally with | SequencePointAtFinally m -> CG.EmitSeqPoint cgbuf m; SPAlways | NoSequencePointAtFinally -> SPSuppress - GenExpr cenv cgbuf eenvinner sp handlerExpr (LeaveHandler (true, whereToSave,afterHandler)); + GenExpr cenv cgbuf eenvinner sp handlerExpr (LeaveHandler (true, whereToSave,afterHandler)) let endOfHandler = CG.GenerateMark cgbuf "endOfHandler" let handlerMarks = (startOfHandler.CodeLabel, endOfHandler.CodeLabel) cgbuf.EmitExceptionClause @@ -2815,68 +2832,68 @@ and GenForLoop cenv cgbuf eenv (spFor,v,e1,dir,e2,loopBody,m) sequel = let test = CG.GenerateDelayMark cgbuf "for_test" let stack,eenvinner = EmitSaveStack cenv cgbuf eenv m (start,finish) - let isUp = (match dir with | FSharpForLoopUp | CSharpForLoopUp -> true | FSharpForLoopDown -> false); - let isFSharpStyle = (match dir with FSharpForLoopUp | FSharpForLoopDown -> true | CSharpForLoopUp -> false); + let isUp = (match dir with | FSharpForLoopUp | CSharpForLoopUp -> true | FSharpForLoopDown -> false) + let isFSharpStyle = (match dir with FSharpForLoopUp | FSharpForLoopDown -> true | CSharpForLoopUp -> false) let finishIdx,eenvinner = if isFSharpStyle then - let v,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("endLoop",m), cenv.g.ilg.typ_int32) (start,finish) + let v,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("endLoop",m), cenv.g.ilg.typ_int32, false) (start,finish) v, eenvinner else -1,eenvinner let _, eenvinner = AllocLocalVal cenv cgbuf v eenvinner None (start,finish) (* note: eenvStack noted stack spill vars are live *) match spFor with - | SequencePointAtForLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart; + | SequencePointAtForLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart | NoSequencePointAtForLoop -> () - GenExpr cenv cgbuf eenv SPSuppress e1 Continue; - GenStoreVal cgbuf eenvinner m v; + GenExpr cenv cgbuf eenv SPSuppress e1 Continue + GenStoreVal cgbuf eenvinner m v if isFSharpStyle then - GenExpr cenv cgbuf eenvinner SPSuppress e2 Continue; + GenExpr cenv cgbuf eenvinner SPSuppress e2 Continue EmitSetLocal cgbuf finishIdx EmitGetLocal cgbuf cenv.g.ilg.typ_int32 finishIdx - GenGetLocalVal cenv cgbuf eenvinner e2.Range v None; - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp ((if isUp then BI_blt else BI_bgt),finish.CodeLabel)); + GenGetLocalVal cenv cgbuf eenvinner e2.Range v None + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp ((if isUp then BI_blt else BI_bgt),finish.CodeLabel)) else - CG.EmitInstr cgbuf (pop 0) Push0 (I_br test.CodeLabel); + CG.EmitInstr cgbuf (pop 0) Push0 (I_br test.CodeLabel) // .inner - CG.SetMarkToHere cgbuf inner; + CG.SetMarkToHere cgbuf inner // - GenExpr cenv cgbuf eenvinner SPAlways loopBody discard; + GenExpr cenv cgbuf eenvinner SPAlways loopBody discard // v++ or v-- - GenGetLocalVal cenv cgbuf eenvinner e2.Range v None; + GenGetLocalVal cenv cgbuf eenvinner e2.Range v None - CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_int32]) (mkLdcInt32 1); - CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub); - GenStoreVal cgbuf eenvinner m v; + CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_int32]) (mkLdcInt32 1) + CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub) + GenStoreVal cgbuf eenvinner m v // .text - CG.SetMarkToHere cgbuf test; + CG.SetMarkToHere cgbuf test // FSharpForLoopUp: if v <> e2 + 1 then goto .inner // FSharpForLoopDown: if v <> e2 - 1 then goto .inner // CSharpStyle: if v < e2 then goto .inner - CG.EmitSeqPoint cgbuf e2.Range; - GenGetLocalVal cenv cgbuf eenvinner e2.Range v None; + CG.EmitSeqPoint cgbuf e2.Range + GenGetLocalVal cenv cgbuf eenvinner e2.Range v None let cmp = match dir with FSharpForLoopUp | FSharpForLoopDown -> BI_bne_un | CSharpForLoopUp -> BI_blt - let e2Sequel = (CmpThenBrOrContinue (pop 2, [ I_brcmp(cmp,inner.CodeLabel) ])); + let e2Sequel = (CmpThenBrOrContinue (pop 2, [ I_brcmp(cmp,inner.CodeLabel) ])) if isFSharpStyle then EmitGetLocal cgbuf cenv.g.ilg.typ_int32 finishIdx - CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_int32]) (mkLdcInt32 1); - CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub); + CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_int32]) (mkLdcInt32 1) + CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub) GenSequel cenv eenv.cloc cgbuf e2Sequel else - GenExpr cenv cgbuf eenv SPSuppress e2 e2Sequel; + GenExpr cenv cgbuf eenv SPSuppress e2 e2Sequel // .finish - loop-exit here - CG.SetMarkToHere cgbuf finish; + CG.SetMarkToHere cgbuf finish // Restore the stack and load the result - EmitRestoreStack cgbuf stack; + EmitRestoreStack cgbuf stack GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel //-------------------------------------------------------------------------- @@ -2888,14 +2905,14 @@ and GenWhileLoop cenv cgbuf eenv (spWhile,e1,e2,m) sequel = let startTest = CG.GenerateMark cgbuf "startTest" match spWhile with - | SequencePointAtWhileLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart; + | SequencePointAtWhileLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart | NoSequencePointAtWhileLoop -> () // SEQUENCE POINTS: Emit a sequence point to cover all of 'while e do' - GenExpr cenv cgbuf eenv SPSuppress e1 (CmpThenBrOrContinue (pop 1, [ I_brcmp(BI_brfalse,finish.CodeLabel) ])); + GenExpr cenv cgbuf eenv SPSuppress e1 (CmpThenBrOrContinue (pop 1, [ I_brcmp(BI_brfalse,finish.CodeLabel) ])) - GenExpr cenv cgbuf eenv SPAlways e2 (DiscardThen (Br startTest)); - CG.SetMarkToHere cgbuf finish; + GenExpr cenv cgbuf eenv SPAlways e2 (DiscardThen (Br startTest)) + CG.SetMarkToHere cgbuf finish // SEQUENCE POINTS: Emit a sequence point to cover 'done' if present GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel @@ -2915,11 +2932,11 @@ and GenSequential cenv cgbuf eenv spIn (e1,e2,specialSeqFlag,spSeq,_m) sequel = | SuppressSequencePointOnStmtOfSequential -> spIn,SPSuppress) match specialSeqFlag with | NormalSeq -> - GenExpr cenv cgbuf eenv spAction e1 discard; + GenExpr cenv cgbuf eenv spAction e1 discard GenExpr cenv cgbuf eenv spExpr e2 sequel | ThenDoSeq -> - GenExpr cenv cgbuf eenv spExpr e1 Continue; - GenExpr cenv cgbuf eenv spAction e2 discard; + GenExpr cenv cgbuf eenv spExpr e1 Continue + GenExpr cenv cgbuf eenv spAction e2 discard GenSequel cenv eenv.cloc cgbuf sequel //-------------------------------------------------------------------------- @@ -2971,7 +2988,7 @@ and GenAsmCode cenv cgbuf eenv (il,tyargs,args,returnTys,m) sequel = // "Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr." | _ -> - if not (isNil tyargs) then err "Bad polymorphic IL instruction"; + if not (isNil tyargs) then err "Bad polymorphic IL instruction" i) match ilAfterInst,args,sequel,ilReturnTys with @@ -2980,7 +2997,7 @@ and GenAsmCode cenv cgbuf eenv (il,tyargs,args,returnTys,m) sequel = | [typ] -> GenDefaultValue cenv cgbuf eenv (typ,m) GenSequel cenv eenv.cloc cgbuf sequel - | _ -> failwith "Bad polymorphic IL instruction"; + | _ -> failwith "Bad polymorphic IL instruction" // Strip off any ("ceq" x false) when the sequel is a comparison branch and change the BI_brfalse to a BI_brtrue // This is the instruction sequence for "not" @@ -2995,13 +3012,13 @@ and GenAsmCode cenv cgbuf eenv (il,tyargs,args,returnTys,m) sequel = // Query; when do we get a 'ret' in IL assembly code? | [ I_ret ], [arg1],sequel,[_ilRetTy] -> - GenExpr cenv cgbuf eenv SPSuppress arg1 Continue; - CG.EmitInstr cgbuf (pop 1) Push0 I_ret; + GenExpr cenv cgbuf eenv SPSuppress arg1 Continue + CG.EmitInstr cgbuf (pop 1) Push0 I_ret GenSequelEndScopes cgbuf sequel // Query; when do we get a 'ret' in IL assembly code? | [ I_ret ], [],sequel,[_ilRetTy] -> - CG.EmitInstr cgbuf (pop 1) Push0 I_ret; + CG.EmitInstr cgbuf (pop 1) Push0 I_ret GenSequelEndScopes cgbuf sequel // 'throw' instructions are a bit of a problem - e.g. let x = (throw ...) in ... expects a value *) @@ -3014,60 +3031,60 @@ and GenAsmCode cenv cgbuf eenv (il,tyargs,args,returnTys,m) sequel = match sequelIgnoreEndScopes sequel with | s when IsSequelImmediate s -> (* In most cases we can avoid doing this... *) - GenExpr cenv cgbuf eenv SPSuppress arg1 Continue; - CG.EmitInstr cgbuf (pop 1) Push0 I_throw; + GenExpr cenv cgbuf eenv SPSuppress arg1 Continue + CG.EmitInstr cgbuf (pop 1) Push0 I_throw GenSequelEndScopes cgbuf sequel | _ -> let after1 = CG.GenerateDelayMark cgbuf ("fake_join") let after2 = CG.GenerateDelayMark cgbuf ("fake_join") let after3 = CG.GenerateDelayMark cgbuf ("fake_join") - CG.EmitInstrs cgbuf (pop 0) Push0 [mkLdcInt32 0; I_brcmp (BI_brfalse,after2.CodeLabel); ]; + CG.EmitInstrs cgbuf (pop 0) Push0 [mkLdcInt32 0; I_brcmp (BI_brfalse,after2.CodeLabel) ] - CG.SetMarkToHere cgbuf after1; - CG.EmitInstrs cgbuf (pop 0) (Push [ilRetTy]) [AI_ldnull; I_unbox_any ilRetTy; I_br after3.CodeLabel ]; + CG.SetMarkToHere cgbuf after1 + CG.EmitInstrs cgbuf (pop 0) (Push [ilRetTy]) [AI_ldnull; I_unbox_any ilRetTy; I_br after3.CodeLabel ] - CG.SetMarkToHere cgbuf after2; - GenExpr cenv cgbuf eenv SPSuppress arg1 Continue; - CG.EmitInstr cgbuf (pop 1) Push0 I_throw; - CG.SetMarkToHere cgbuf after3; - GenSequel cenv eenv.cloc cgbuf sequel; + CG.SetMarkToHere cgbuf after2 + GenExpr cenv cgbuf eenv SPSuppress arg1 Continue + CG.EmitInstr cgbuf (pop 1) Push0 I_throw + CG.SetMarkToHere cgbuf after3 + GenSequel cenv eenv.cloc cgbuf sequel | _ -> // float or float32 or float<_> or float32<_> let g = cenv.g in let anyfpType ty = typeEquivAux EraseMeasures g g.float_ty ty || typeEquivAux EraseMeasures g g.float32_ty ty // Otherwise generate the arguments, and see if we can use a I_brcmp rather than a comparison followed by an I_brfalse/I_brtrue - GenExprs cenv cgbuf eenv args; + GenExprs cenv cgbuf eenv args match ilAfterInst,sequel with // NOTE: THESE ARE NOT VALID ON FLOATING POINT DUE TO NaN. Hence INLINE ASM ON FP. MUST BE CAREFULLY WRITTEN | [ AI_clt ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bge,label1)); + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bge,label1)) | [ AI_cgt ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_ble,label1)); + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_ble,label1)) | [ AI_clt_un ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bge_un,label1)); + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bge_un,label1)) | [ AI_cgt_un ], CmpThenBrOrContinue(1, [I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_ble_un,label1)); + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_ble_un,label1)) | [ AI_ceq ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bne_un,label1)); + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bne_un,label1)) // THESE ARE VALID ON FP w.r.t. NaN | [ AI_clt ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brtrue, label1) ]) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_blt,label1)); + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_blt,label1)) | [ AI_cgt ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brtrue, label1) ]) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bgt,label1)); + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bgt,label1)) | [ AI_clt_un ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brtrue, label1) ]) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_blt_un,label1)); + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_blt_un,label1)) | [ AI_cgt_un ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brtrue, label1) ]) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bgt_un,label1)); + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bgt_un,label1)) | [ AI_ceq ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brtrue, label1) ]) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_beq,label1)); + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_beq,label1)) | _ -> // Failing that, generate the real IL leaving value(s) on the stack - CG.EmitInstrs cgbuf (pop args.Length) (Push ilReturnTys) ilAfterInst; + CG.EmitInstrs cgbuf (pop args.Length) (Push ilReturnTys) ilAfterInst // If no return values were specified generate a "unit" if isNil returnTys then @@ -3147,8 +3164,8 @@ and GenILCall cenv cgbuf eenv (virt,valu,newobj,valUseFlags,isDllImport,ilMethRe // Load the 'this' pointer to pass to the superclass constructor. This argument is not // in the expression tree since it can't be treated like an ordinary value - if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [ilMethSpec.EnclosingType]) [ mkLdarg0 ] ; - GenExprs cenv cgbuf eenv argExprs; + if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [ilMethSpec.EnclosingType]) [ mkLdarg0 ] + GenExprs cenv cgbuf eenv argExprs let il = if newobj then [ I_newobj(ilMethSpec,None) ] else @@ -3160,11 +3177,11 @@ and GenILCall cenv cgbuf eenv (virt,valu,newobj,valUseFlags,isDllImport,ilMethRe if useICallVirt then [ I_callvirt(tail,ilMethSpec,None) ] else [ I_call(tail,ilMethSpec,None) ] - CG.EmitInstrs cgbuf (pop (argExprs.Length + (if isSuperInit then 1 else 0))) (if isSuperInit then Push0 else Push ilReturnTys) il; + CG.EmitInstrs cgbuf (pop (argExprs.Length + (if isSuperInit then 1 else 0))) (if isSuperInit then Push0 else Push ilReturnTys) il // Load the 'this' pointer as the pretend 'result' of the isSuperInit operation. // It will be immediately popped in most cases, but may also be used as the target of ome "property set" operations. - if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [ilMethSpec.EnclosingType]) [ mkLdarg0 ] ; + if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [ilMethSpec.EnclosingType]) [ mkLdarg0 ] CommitCallSequel cenv eenv m eenv.cloc cgbuf mustGenerateUnitAfterCall sequel and CommitCallSequel cenv eenv m cloc cgbuf mustGenerateUnitAfterCall sequel = @@ -3190,9 +3207,9 @@ and GenTraitCall cenv cgbuf eenv (traitInfo, argExprs, m) expr sequel = //-------------------------------------------------------------------------- and GenGetAddrOfRefCellField cenv cgbuf eenv (e,ty,m) sequel = - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let fref = GenRecdFieldRef m cenv eenv.tyenv (mkRefCellContentsRef cenv.g) [ty] - CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fref.ActualType]) [ I_ldflda fref ] ; + CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fref.ActualType]) [ I_ldflda fref ] GenSequel cenv eenv.cloc cgbuf sequel and GenGetValAddr cenv cgbuf eenv (v: ValRef, m) sequel = @@ -3200,32 +3217,32 @@ and GenGetValAddr cenv cgbuf eenv (v: ValRef, m) sequel = let ilTy = GenTypeOfVal cenv eenv vspec match StorageForValRef m v eenv with | Local (idx,None) -> - CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ I_ldloca (uint16 idx) ] ; + CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ I_ldloca (uint16 idx) ] | Arg idx -> - CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ I_ldarga (uint16 idx) ] ; + CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ I_ldarga (uint16 idx) ] | StaticField (fspec, _vref, hasLiteralAttr, _ilTyForProperty, _, ilTy, _, _, _) -> - if hasLiteralAttr then errorR(Error(FSComp.SR.ilAddressOfLiteralFieldIsInvalid(),m)); + if hasLiteralAttr then errorR(Error(FSComp.SR.ilAddressOfLiteralFieldIsInvalid(),m)) let ilTy = if ilTy.IsNominal && ilTy.Boxity = ILBoxity.AsValue then ILType.Byref ilTy else ilTy EmitGetStaticFieldAddr cgbuf ilTy fspec | Env (_,_,ilField,_) -> - CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ mkLdarg0; mkNormalLdflda ilField ]; + CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ mkLdarg0; mkNormalLdflda ilField ] | Local (_,Some _) | StaticProperty _ | Method _ | Env _ | Unrealized | Null -> - errorR(Error(FSComp.SR.ilAddressOfValueHereIsInvalid(v.DisplayName),m)); + errorR(Error(FSComp.SR.ilAddressOfValueHereIsInvalid(v.DisplayName),m)) CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref ilTy]) [ I_ldarga (uint16 669 (* random value for post-hoc diagnostic analysis on generated tree *) ) ] ; GenSequel cenv eenv.cloc cgbuf sequel and GenGetByref cenv cgbuf eenv (v:ValRef,m) sequel = - GenGetLocalVRef cenv cgbuf eenv m v None; + GenGetLocalVRef cenv cgbuf eenv m v None let ilty = GenType cenv.amap m cenv.g eenv.tyenv (destByrefTy cenv.g v.Type) - CG.EmitInstrs cgbuf (pop 1) (Push [ilty]) [ mkNormalLdobj ilty ]; + CG.EmitInstrs cgbuf (pop 1) (Push [ilty]) [ mkNormalLdobj ilty ] GenSequel cenv eenv.cloc cgbuf sequel and GenSetByref cenv cgbuf eenv (v:ValRef,e,m) sequel = - GenGetLocalVRef cenv cgbuf eenv m v None; - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenGetLocalVRef cenv cgbuf eenv m v None + GenExpr cenv cgbuf eenv SPSuppress e Continue let ilty = GenType cenv.amap m cenv.g eenv.tyenv (destByrefTy cenv.g v.Type) - CG.EmitInstrs cgbuf (pop 2) Push0 [ mkNormalStobj ilty ]; + CG.EmitInstrs cgbuf (pop 2) Push0 [ mkNormalStobj ilty ] GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel and GenDefaultValue cenv cgbuf eenv (ty,m) = @@ -3253,14 +3270,14 @@ and GenDefaultValue cenv cgbuf eenv (ty,m) = | _ -> let ilTy = GenType cenv.amap m cenv.g eenv.tyenv ty LocalScope "ilzero" cgbuf (fun scopeMarks -> - let locIdx, _ = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("default",m), ilTy) scopeMarks + let locIdx, _ = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("default",m), ilTy, false) scopeMarks // "initobj" (Generated by EmitInitLocal) doesn't work on byref types // But ilzero(&ty) only gets generated in the built-in get-address function so // we can just rely on zeroinit of all IL locals. match ilTy with | ILType.Byref _ -> () | _ -> EmitInitLocal cgbuf ilTy locIdx - EmitGetLocal cgbuf ilTy locIdx; + EmitGetLocal cgbuf ilTy locIdx ) //-------------------------------------------------------------------------- @@ -3291,13 +3308,13 @@ and GenGenericParam cenv eenv (tp:Typar) = elif nm.Length >= 1 && nm.[0] = 'T' && (nm.Length = 1 || not (System.Char.IsLower nm.[1])) then nm else "T" + (String.capitalize nm) else - nm; + nm - Constraints=mkILTypes subTypeConstraints; - Variance=NonVariant; - CustomAttrs = mkILCustomAttrs (GenAttrs cenv eenv tp.Attribs); - HasReferenceTypeConstraint=refTypeConstraint; - HasNotNullableValueTypeConstraint=notNullableValueTypeConstraint; + Constraints=mkILTypes subTypeConstraints + Variance=NonVariant + CustomAttrs = mkILCustomAttrs (GenAttrs cenv eenv tp.Attribs) + HasReferenceTypeConstraint=refTypeConstraint + HasNotNullableValueTypeConstraint=notNullableValueTypeConstraint HasDefaultConstructorConstraint= defaultConstructorConstraint } //-------------------------------------------------------------------------- @@ -3307,13 +3324,13 @@ and GenGenericParam cenv eenv (tp:Typar) = and GenSlotParam m cenv eenv (TSlotParam(nm,ty,inFlag,outFlag,optionalFlag,attribs)) : ILParameter = let inFlag2,outFlag2,optionalFlag2,paramMarshal2,attribs = GenParamAttribs cenv attribs - { Name=nm; - Type= GenParamType cenv.amap m cenv.g eenv.tyenv ty; - Default=None; - Marshal=paramMarshal2; - IsIn=inFlag || inFlag2; - IsOut=outFlag || outFlag2; - IsOptional=optionalFlag || optionalFlag2; + { Name=nm + Type= GenParamType cenv.amap m cenv.g eenv.tyenv ty + Default=None + Marshal=paramMarshal2 + IsIn=inFlag || inFlag2 + IsOut=outFlag || outFlag2 + IsOptional=optionalFlag || optionalFlag2 CustomAttrs= mkILCustomAttrs (GenAttrs cenv eenv attribs) } and GenFormalSlotsig m cenv eenv (TSlotSig(_,typ,ctps,mtps,paraml,returnTy)) = @@ -3351,7 +3368,7 @@ and GenMethodImpl cenv eenv (useMethodImpl,(TSlotSig(nameOfOverridenMethod,_,_,_ let ilOverrideMethGenericParams = GenGenericParams cenv eenvForOverrideBy methTyparsOfOverridingMethod let ilOverrideMethGenericArgs = mkILFormalGenericArgs ilOverrideMethGenericParams let ilOverrideBy = mkILInstanceMethSpecInTy(ilTyForOverriding, nameOfOverridingMethod, typesOfILParamsList ilParamsOfOverridingMethod, ilReturnOfOverridingMethod.Type, ilOverrideMethGenericArgs) - { Overrides = OverridesSpec(ilOverrideMethRef,ilOverrideTy); + { Overrides = OverridesSpec(ilOverrideMethRef,ilOverrideTy) OverrideBy = ilOverrideBy }) and bindBaseOrThisVarOpt cenv eenv baseValOpt = @@ -3361,7 +3378,7 @@ and bindBaseOrThisVarOpt cenv eenv baseValOpt = and fixupVirtualSlotFlags mdef = {mdef with - IsHideBySig=true; + IsHideBySig=true mdKind = (match mdef.mdKind with | MethodKind.Virtual vinfo -> MethodKind.Virtual @@ -3374,15 +3391,15 @@ and renameMethodDef nameOfOverridingMethod (mdef : ILMethodDef) = and fixupMethodImplFlags mdef = {mdef with - Access=ILMemberAccess.Private; - IsHideBySig=true; + Access=ILMemberAccess.Private + IsHideBySig=true mdKind=(match mdef.mdKind with | MethodKind.Virtual vinfo -> MethodKind.Virtual {vinfo with - IsCheckAccessOnOverride=false; - IsFinal=true; - IsNewSlot=true; } + IsCheckAccessOnOverride=false + IsFinal=true + IsNewSlot=true } | _ -> failwith "fixupMethodImpl") } and GenObjectMethod cenv eenvinner (cgbuf:CodeGenBuffer) useMethodImpl tmethod = @@ -3429,7 +3446,7 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType,baseValOpt,basecall,overri let ilxCloSpec = cloinfo.cloSpec let ilCloFreeVars = cloinfo.cloILFreeVars let ilCloGenericFormals = cloinfo.cloILGenericParams - assert(isNil cloinfo.localTypeFuncDirectILGenericParams); + assert(isNil cloinfo.localTypeFuncDirectILGenericParams) let ilCloGenericActuals = cloinfo.cloSpec.GenericArgs let ilCloRetTy = cloinfo.cloILFormalRetTy let ilCloTypeRef = cloinfo.cloSpec.TypeRef @@ -3462,10 +3479,10 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType,baseValOpt,basecall,overri let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef,ilCloGenericFormals,attrs,ilCloFreeVars,ilCloLambdas,ilCtorBody,mdefs,mimpls,super,interfaceTys) for cloTypeDef in cloTypeDefs do - cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None); - CountClosure(); - GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars; - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor,None)); + cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) + CountClosure() + GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars + CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor,None)) GenSequel cenv eenvouter.cloc cgbuf sequel and GenSequenceExpr cenv (cgbuf:CodeGenBuffer) eenvouter (nextEnumeratorValRef:ValRef,pcvref:ValRef,currvref:ValRef,stateVars,generateNextExpr,closeExpr,checkCloseExpr:Expr,seqElemTy, m) sequel = @@ -3511,8 +3528,8 @@ and GenSequenceExpr cenv (cgbuf:CodeGenBuffer) eenvouter (nextEnumeratorValRef:V if stateVarsSet.Contains fv then GenDefaultValue cenv cgbuf eenv (fv.Type,m) else - GenGetLocalVal cenv cgbuf eenv m fv None; - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyInner]) (I_newobj (formalClospec.Constructor,None)); + GenGetLocalVal cenv cgbuf eenv m fv None + CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyInner]) (I_newobj (formalClospec.Constructor,None)) GenSequel cenv eenv.cloc cgbuf Return), m) mkILNonGenericVirtualMethod("GetFreshEnumerator",ILMemberAccess.Public, [], mkILReturn ilCloEnumeratorTy, MethodBody.IL mbody) @@ -3545,17 +3562,17 @@ and GenSequenceExpr cenv (cgbuf:CodeGenBuffer) eenvouter (nextEnumeratorValRef:V let attrs = GenAttrs cenv eenvinner cloAttribs let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef,ilCloGenericParams,attrs,ilCloFreeVars,ilCloLambdas,ilCtorBody,[generateNextMethod;closeMethod;checkCloseMethod;lastGeneratedMethod;getFreshMethod],[],ilCloBaseTy,[]) for cloTypeDef in cloTypeDefs do - cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None); - CountClosure(); + cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) + CountClosure() for fv in cloFreeVars do /// State variables always get zero-initialized if stateVarsSet.Contains fv then GenDefaultValue cenv cgbuf eenvouter (fv.Type,m) else - GenGetLocalVal cenv cgbuf eenvouter m fv None; + GenGetLocalVal cenv cgbuf eenvouter m fv None - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyOuter]) (I_newobj (ilxCloSpec.Constructor,None)); + CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyOuter]) (I_newobj (ilxCloSpec.Constructor,None)) GenSequel cenv eenvouter.cloc cgbuf sequel @@ -3570,29 +3587,29 @@ and GenClosureTypeDefs cenv (tref:ILTypeRef, ilGenParams, attrs, ilCloFreeVars, cloCode=notlazy ilCtorBody } let td = - { Name = tref.Name; - Layout = ILTypeDefLayout.Auto; - Access = ComputeTypeAccess tref true; - GenericParams = ilGenParams; - CustomAttrs = mkILCustomAttrs(attrs @ [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Closure) ]); - Fields = emptyILFields; - InitSemantics=ILTypeInit.BeforeField; - IsSealed=true; - IsAbstract=false; - tdKind=ILTypeDefKind.Class; - Events= emptyILEvents; - Properties = emptyILProperties; - Methods= mkILMethods mdefs; - MethodImpls= mkILMethodImpls mimpls; - IsSerializable= cenv.opts.netFxHasSerializableAttribute; - IsComInterop= false; - IsSpecialName= true; - NestedTypes=emptyILTypeDefs; - Encoding= ILDefaultPInvokeEncoding.Auto; - Implements= mkILTypes ilIntfTys; - Extends= Some ext; - SecurityDecls= emptyILSecurityDecls; - HasSecurity=false; } + { Name = tref.Name + Layout = ILTypeDefLayout.Auto + Access = ComputeTypeAccess tref true + GenericParams = ilGenParams + CustomAttrs = mkILCustomAttrs(attrs @ [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Closure) ]) + Fields = emptyILFields + InitSemantics=ILTypeInit.BeforeField + IsSealed=true + IsAbstract=false + tdKind=ILTypeDefKind.Class + Events= emptyILEvents + Properties = emptyILProperties + Methods= mkILMethods mdefs + MethodImpls= mkILMethodImpls mimpls + IsSerializable= cenv.opts.netFxHasSerializableAttribute + IsComInterop= false + IsSpecialName= true + NestedTypes=emptyILTypeDefs + Encoding= ILDefaultPInvokeEncoding.Auto + Implements= mkILTypes ilIntfTys + Extends= Some ext + SecurityDecls= emptyILSecurityDecls + HasSecurity=false } let tdefs = EraseClosures.convIlxClosureDef cenv.g.ilxPubCloEnv tref.Enclosing td cloInfo tdefs @@ -3626,30 +3643,30 @@ and GenLambdaClosure cenv (cgbuf:CodeGenBuffer) eenv isLocalTypeFunc selfv expr let ilContractMeths = [ilContractCtor; mkILGenericVirtualMethod("DirectInvoke",ILMemberAccess.Assembly,ilContractMethTyargs,[],mkILReturn ilContractFormalRetTy, MethodBody.Abstract) ] let ilContractTypeDef = - { Name = ilContractTypeRef.Name; - Layout = ILTypeDefLayout.Auto; - Access = ComputeTypeAccess ilContractTypeRef true; - GenericParams = ilContractGenericParams; - CustomAttrs = mkILCustomAttrs [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Closure) ]; - Fields = emptyILFields; - InitSemantics=ILTypeInit.BeforeField; - IsSealed=false; // the contract type is an abstract type and not sealed - IsAbstract=true; // the contract type is an abstract type - tdKind=ILTypeDefKind.Class; - Events= emptyILEvents; - Properties = emptyILProperties; - Methods= mkILMethods ilContractMeths; - MethodImpls= emptyILMethodImpls; - IsSerializable= cenv.opts.netFxHasSerializableAttribute; - IsComInterop=false; - IsSpecialName= true; - NestedTypes=emptyILTypeDefs; - Encoding= ILDefaultPInvokeEncoding.Auto; - Implements= mkILTypes []; - Extends= Some cenv.g.ilg.typ_Object; - SecurityDecls= emptyILSecurityDecls; - HasSecurity=false; } - cgbuf.mgbuf.AddTypeDef(ilContractTypeRef, ilContractTypeDef, false, false, None); + { Name = ilContractTypeRef.Name + Layout = ILTypeDefLayout.Auto + Access = ComputeTypeAccess ilContractTypeRef true + GenericParams = ilContractGenericParams + CustomAttrs = mkILCustomAttrs [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Closure) ] + Fields = emptyILFields + InitSemantics=ILTypeInit.BeforeField + IsSealed=false // the contract type is an abstract type and not sealed + IsAbstract=true // the contract type is an abstract type + tdKind=ILTypeDefKind.Class + Events= emptyILEvents + Properties = emptyILProperties + Methods= mkILMethods ilContractMeths + MethodImpls= emptyILMethodImpls + IsSerializable= cenv.opts.netFxHasSerializableAttribute + IsComInterop=false + IsSpecialName= true + NestedTypes=emptyILTypeDefs + Encoding= ILDefaultPInvokeEncoding.Auto + Implements= mkILTypes [] + Extends= Some cenv.g.ilg.typ_Object + SecurityDecls= emptyILSecurityDecls + HasSecurity=false } + cgbuf.mgbuf.AddTypeDef(ilContractTypeRef, ilContractTypeDef, false, false, None) let ilCtorBody = mkILMethodBody (true,emptyILLocals,8,nonBranchingInstrsToCode (mkCallBaseConstructor(ilContractTy,[])), None ) let cloMethods = [ mkILGenericVirtualMethod("DirectInvoke",ILMemberAccess.Assembly,cloinfo.localTypeFuncDirectILGenericParams,[],mkILReturn (cloinfo.cloILFormalRetTy), MethodBody.IL ilCloBody) ] @@ -3658,14 +3675,14 @@ and GenLambdaClosure cenv (cgbuf:CodeGenBuffer) eenv isLocalTypeFunc selfv expr else GenClosureTypeDefs cenv (ilCloTypeRef,cloinfo.cloILGenericParams,[],cloinfo.cloILFreeVars,cloinfo.ilCloLambdas,ilCloBody,[],[],cenv.g.ilg.typ_Object,[]) - CountClosure(); + CountClosure() for cloTypeDef in cloTypeDefs do - cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None); + cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) cloinfo,m | _ -> failwith "GenLambda: not a lambda" and GenLambdaVal cenv (cgbuf:CodeGenBuffer) eenv (cloinfo,m) = - GenGetLocalVals cenv cgbuf eenv m cloinfo.cloFreeVars; + GenGetLocalVals cenv cgbuf eenv m cloinfo.cloFreeVars CG.EmitInstr cgbuf (pop cloinfo.cloILFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv cloinfo.ilCloLambdas]) @@ -3673,7 +3690,7 @@ and GenLambdaVal cenv (cgbuf:CodeGenBuffer) eenv (cloinfo,m) = and GenLambda cenv cgbuf eenv isLocalTypeFunc selfv expr sequel = let cloinfo,m = GenLambdaClosure cenv cgbuf eenv isLocalTypeFunc selfv expr - GenLambdaVal cenv cgbuf eenv (cloinfo,m); + GenLambdaVal cenv cgbuf eenv (cloinfo,m) GenSequel cenv eenv.cloc cgbuf sequel and GenTypeOfVal cenv eenv (v:Val) = @@ -3900,20 +3917,20 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloFreeVars), mkILGenericArgs ilCloGenericActuals) let cloinfo = - { cloExpr=expr; - cloName=ilCloTypeRef.Name; - cloArityInfo =narginfo; - ilCloLambdas=ilCloLambdas; - cloILFreeVars = ilCloFreeVars; - cloILFormalRetTy=ilReturnTy; - cloSpec = ilxCloSpec; - cloILGenericParams = ilCloGenericFormals; - cloFreeVars=cloFreeVars; - cloAttribs=cloAttribs; - localTypeFuncContractFreeTypars = cloContractFreeTyvars; - localTypeFuncInternalFreeTypars = cloInternalFreeTyvars; - localTypeFuncILGenericArgs = ilContractGenericActuals; - localTypeFuncDirectILGenericParams = ilDirectGenericParams; } + { cloExpr=expr + cloName=ilCloTypeRef.Name + cloArityInfo =narginfo + ilCloLambdas=ilCloLambdas + cloILFreeVars = ilCloFreeVars + cloILFormalRetTy=ilReturnTy + cloSpec = ilxCloSpec + cloILGenericParams = ilCloGenericFormals + cloFreeVars=cloFreeVars + cloAttribs=cloAttribs + localTypeFuncContractFreeTypars = cloContractFreeTyvars + localTypeFuncInternalFreeTypars = cloInternalFreeTyvars + localTypeFuncILGenericArgs = ilContractGenericActuals + localTypeFuncDirectILGenericParams = ilDirectGenericParams } cloinfo,body,eenvinner //-------------------------------------------------------------------------- @@ -3996,19 +4013,19 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_,delega let ilAttribs = GenAttrs cenv eenvinner cloAttribs let cloTypeDefs = GenClosureTypeDefs cenv (ilDelegeeTypeRef,ilDelegeeGenericParams,ilAttribs,ilCloFreeVars,ilCloLambdas,ilCtorBody,[delegeeInvokeMeth],[],cenv.g.ilg.typ_Object,[]) for cloTypeDef in cloTypeDefs do - cgbuf.mgbuf.AddTypeDef(ilDelegeeTypeRef, cloTypeDef, false, false, None); - CountClosure(); + cgbuf.mgbuf.AddTypeDef(ilDelegeeTypeRef, cloTypeDef, false, false, None) + CountClosure() let ctxtGenericArgsForDelegee = GenGenericArgs m eenvouter.tyenv cloFreeTyvars let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilDelegeeTypeRef, ilCloLambdas, ilCloFreeVars), mkILGenericArgs ctxtGenericArgsForDelegee) - GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars; - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor,None)); + GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars + CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor,None)) let ilDelegeeTyOuter = mkILBoxedTy ilDelegeeTypeRef ctxtGenericArgsForDelegee let ilDelegeeInvokeMethOuter = mkILNonGenericInstanceMethSpecInTy (ilDelegeeTyOuter,"Invoke",typesOfILParamsList ilDelegeeParams, ilDelegeeRet.Type) let ilDelegeeCtorMethOuter = mkCtorMethSpecForDelegate cenv.g.ilg (ilCtxtDelTy,useUIntPtrForDelegateCtor) CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_IntPtr]) (I_ldftn ilDelegeeInvokeMethOuter) - CG.EmitInstr cgbuf (pop 2) (Push [ilCtxtDelTy]) (I_newobj(ilDelegeeCtorMethOuter,None)); + CG.EmitInstr cgbuf (pop 2) (Push [ilCtxtDelTy]) (I_newobj(ilDelegeeCtorMethOuter,None)) GenSequel cenv eenvouter.cloc cgbuf sequel //------------------------------------------------------------------------- @@ -4102,11 +4119,11 @@ and GenMatch cenv cgbuf eenv (spBind,_exprm,tree,targets,m,ty) sequel = // match-testing (dtrees) should not contribute to the stack. // Each branch-RHS (targets) may contribute to the stack, leaving it in the "stackAfterJoin" state, for the join point. // Since code is branching and joining, the cgbuf stack is maintained manually. - GenDecisionTreeAndTargets cenv cgbuf stackAtTargets eenv tree targets repeatSP sequelOnBranches; - CG.SetMarkToHere cgbuf afterJoin; + GenDecisionTreeAndTargets cenv cgbuf stackAtTargets eenv tree targets repeatSP sequelOnBranches + CG.SetMarkToHere cgbuf afterJoin - //assert(cgbuf.GetCurrentStack() = stackAfterJoin); // REVIEW: Since gen_dtree* now sets stack, stack should be stackAfterJoin at this point... - CG.SetStack cgbuf stackAfterJoin; + //assert(cgbuf.GetCurrentStack() = stackAfterJoin) // REVIEW: Since gen_dtree* now sets stack, stack should be stackAfterJoin at this point... + CG.SetStack cgbuf stackAfterJoin // If any values are left on the stack after the join then we're certainly going to do something with them // For example, we may be about to execute a 'stloc' for // @@ -4119,7 +4136,7 @@ and GenMatch cenv cgbuf eenv (spBind,_exprm,tree,targets,m,ty) sequel = // In both cases, any instructions that come after this point will be falsely associated with the last branch of the control // prior to the join point. This is base, e.g. see FSharp 1.0 bug 5155 if nonNil stackAfterJoin then - cgbuf.EmitStartOfHiddenCode(); + cgbuf.EmitStartOfHiddenCode() GenSequel cenv eenv.cloc cgbuf sequelAfterJoin @@ -4138,19 +4155,19 @@ and TryFindTargetInfo targetInfos n = /// When inplabOpt is "Some inplab", we are assuming an existing branch to "inplab" and can optionally /// set inplab to point to another location if no codegen is required. and GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree targets repeatSP targetInfos sequel = - CG.SetStack cgbuf stackAtTargets; // Set the expected initial stack. + CG.SetStack cgbuf stackAtTargets // Set the expected initial stack. match tree with | TDBind(bind,rest) -> match inplabOpt with Some inplab -> CG.SetMarkToHere cgbuf inplab | None -> () let startScope,endScope as scopeMarks = StartDelayedLocalScope "dtreeBind" cgbuf let eenv = AllocStorageForBind cenv cgbuf scopeMarks eenv bind let sp = GenSequencePointForBind cenv cgbuf eenv bind - CG.SetMarkToHere cgbuf startScope; - GenBindAfterSequencePoint cenv cgbuf eenv sp bind; + CG.SetMarkToHere cgbuf startScope + GenBindAfterSequencePoint cenv cgbuf eenv sp bind // We don't get the scope marks quite right for dtree-bound variables. This is because // we effectively lose an EndLocalScope for all dtrees that go to the same target // So we just pretend that the variable goes out of scope here. - CG.SetMarkToHere cgbuf endScope; + CG.SetMarkToHere cgbuf endScope GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv rest targets repeatSP targetInfos sequel | TDSuccess (es,targetIdx) -> @@ -4160,7 +4177,7 @@ and GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases dflt m targets repeatSP targetInfos sequel and GetTarget (targets:_[]) n = - if n >= targets.Length then failwith "GetTarget: target not found in decision tree"; + if n >= targets.Length then failwith "GetTarget: target not found in decision tree" targets.[n] and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targets repeatSP targetInfos sequel = @@ -4173,23 +4190,23 @@ and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx // In this case each case will just go straight to "e" if FlatList.isEmpty vs then match inplabOpt with - | None -> CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkAfterBinds.CodeLabel); - | Some inplab -> CG.SetMark cgbuf inplab targetMarkAfterBinds; + | None -> CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkAfterBinds.CodeLabel) + | Some inplab -> CG.SetMark cgbuf inplab targetMarkAfterBinds else - match inplabOpt with None -> () | Some inplab -> CG.SetMarkToHere cgbuf inplab; - repeatSP(); + match inplabOpt with None -> () | Some inplab -> CG.SetMarkToHere cgbuf inplab + repeatSP() // It would be better not to emit any expressions here, and instead push these assignments into the postponed target // However not all targets are currently postponed (we only postpone in debug code), pending further testing of the performance // impact of postponing. (vs,es) ||> FlatList.iter2 (GenBindRhs cenv cgbuf eenv SPSuppress) vs |> List.rev |> FlatList.iter (fun v -> GenStoreVal cgbuf eenvAtTarget v.Range v) - CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkAfterBinds.CodeLabel); + CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkAfterBinds.CodeLabel) targetInfos | None -> - match inplabOpt with None -> () | Some inplab -> CG.SetMarkToHere cgbuf inplab; + match inplabOpt with None -> () | Some inplab -> CG.SetMarkToHere cgbuf inplab let targetMarkBeforeBinds = CG.GenerateDelayMark cgbuf "targetBeforeBinds" let targetMarkAfterBinds = CG.GenerateDelayMark cgbuf "targetAfterBinds" let startScope,endScope as scopeMarks = StartDelayedLocalScope "targetBinds" cgbuf @@ -4200,10 +4217,10 @@ and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx // In debug mode push all decision tree targets to after the switching let isTargetPostponed = if cenv.opts.localOptimizationsAreOn then - GenDecisionTreeTarget cenv cgbuf stackAtTargets targetIdx targetInfo sequel; + GenDecisionTreeTarget cenv cgbuf stackAtTargets targetIdx targetInfo sequel false else - CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkBeforeBinds.CodeLabel); + CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkBeforeBinds.CodeLabel) true let targetInfos = IntMap.add targetIdx (targetInfo,isTargetPostponed) targetInfos @@ -4233,29 +4250,34 @@ and GenDecisionTreeTarget cenv cgbuf stackAtTargets _targetIdx (targetMarkBefore | SuppressSequencePointAtTarget -> cgbuf.EmitStartOfHiddenCode() CG.SetMarkToHere cgbuf startScope - GenBindings cenv cgbuf eenvAtTarget binds; + GenBindings cenv cgbuf eenvAtTarget binds CG.SetMarkToHere cgbuf targetMarkAfterBinds - CG.SetStack cgbuf stackAtTargets; - GenExpr cenv cgbuf eenvAtTarget spExpr successExpr (EndLocalScope(sequel,endScope)); + CG.SetStack cgbuf stackAtTargets + GenExpr cenv cgbuf eenvAtTarget spExpr successExpr (EndLocalScope(sequel,endScope)) and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defaultTargetOpt switchm targets repeatSP targetInfos sequel = let m = e.Range - match inplabOpt with None -> () | Some inplab -> CG.SetMarkToHere cgbuf inplab; + match inplabOpt with None -> () | Some inplab -> CG.SetMarkToHere cgbuf inplab - repeatSP(); + repeatSP() match cases with // optimize a test against a boolean value, i.e. the all-important if-then-else | TCase(Test.Const(Const.Bool b), successTree) :: _ -> let failureTree = (match defaultTargetOpt with None -> cases.Tail.Head.CaseTree | Some d -> d) GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e None eenv (if b then successTree else failureTree) (if b then failureTree else successTree) targets repeatSP targetInfos sequel - // optimize a single test for a type constructor to an "isdata" test - much + // // Remove a single test for a union case . Union case tests are always exa + //| [ TCase(Test.UnionCase _, successTree) ] when (defaultTargetOpt.IsNone) -> + // GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv successTree targets repeatSP targetInfos sequel + // //GenDecisionTree cenv eenv.cloc cgbuf stackAtTargets e (Some (pop 1, Push [cenv.g.ilg.typ_bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets repeatSP targetInfos sequel + + // Optimize a single test for a union case to an "isdata" test - much // more efficient code, and this case occurs in the generated equality testers where perf is important - | TCase(Test.UnionCase(c,tyargs), successTree) :: rest when List.length rest = (match defaultTargetOpt with None -> 1 | Some _ -> 0) -> + | TCase(Test.UnionCase(c,tyargs), successTree) :: rest when rest.Length = (match defaultTargetOpt with None -> 1 | Some _ -> 0) -> let failureTree = match defaultTargetOpt with - | None -> cases.Tail.Head.CaseTree + | None -> rest.Head.CaseTree | Some tg -> tg let cuspec = GenUnionSpec cenv.amap m cenv.g eenv.tyenv c.TyconRef tyargs let idx = c.Index @@ -4272,45 +4294,45 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau | Test.ArrayLength _ | Test.IsNull | Test.Const(Const.Zero) -> - if List.length cases <> 1 || isNone defaultTargetOpt then failwith "internal error: GenDecisionTreeSwitch: Test.IsInst/isnull/query"; + if List.length cases <> 1 || isNone defaultTargetOpt then failwith "internal error: GenDecisionTreeSwitch: Test.IsInst/isnull/query" let bi = match firstDiscrim with | Test.Const(Const.Zero) -> - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue BI_brfalse | Test.IsNull -> - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let srcTy = tyOfExpr cenv.g e if isTyparTy cenv.g srcTy then let ilFromTy = GenType cenv.amap m cenv.g eenv.tyenv srcTy - CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Object]) (I_box ilFromTy); + CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Object]) (I_box ilFromTy) BI_brfalse | Test.IsInst (_srcty,tgty) -> let e = mkCallTypeTest cenv.g m tgty e - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue BI_brtrue | _ -> failwith "internal error: GenDecisionTreeSwitch" - CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp (bi,(List.head caseLabels).CodeLabel)); + CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp (bi,(List.head caseLabels).CodeLabel)) GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel | Test.ActivePatternCase _ -> error(InternalError("internal error in codegen: Test.ActivePatternCase",switchm)) | Test.UnionCase (hdc,tyargs) -> - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue let cuspec = GenUnionSpec cenv.amap m cenv.g eenv.tyenv hdc.TyconRef tyargs let dests = - if cases.Length <> caseLabels.Length then failwith "internal error: Test.UnionCase"; + if cases.Length <> caseLabels.Length then failwith "internal error: Test.UnionCase" (cases , caseLabels) ||> List.map2 (fun case label -> match case with | TCase(Test.UnionCase (c,_),_) -> (c.Index, label.CodeLabel) | _ -> failwith "error: mixed constructor/const test?") let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib hdc.TyconRef - EraseUnions.emitDataSwitch cenv.g.ilg (UnionCodeGen cgbuf) (avoidHelpers,cuspec,dests); + EraseUnions.emitDataSwitch cenv.g.ilg (UnionCodeGen cgbuf) (avoidHelpers,cuspec,dests) CG.EmitInstrs cgbuf (pop 1) Push0 [ ] // push/pop to match the line above GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel | Test.Const c -> - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue match c with | Const.Bool _ -> failwith "should have been done earlier" | Const.SByte _ @@ -4320,7 +4342,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau | Const.UInt16 _ | Const.UInt32 _ | Const.Char _ -> - if List.length cases <> List.length caseLabels then failwith "internal error: "; + if List.length cases <> List.length caseLabels then failwith "internal error: " let dests = (cases,caseLabels) ||> List.map2 (fun case label -> let i = @@ -4345,16 +4367,16 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau if mx - mn = (List.length dests - 1) then let destinationLabels = dests |> List.sortBy fst |> List.map snd if mn <> 0 then - CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_int32]) [ mkLdcInt32 mn]; - CG.EmitInstrs cgbuf (pop 1) Push0 [ AI_sub ]; - CG.EmitInstr cgbuf (pop 1) Push0 (I_switch destinationLabels); + CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_int32]) [ mkLdcInt32 mn] + CG.EmitInstrs cgbuf (pop 1) Push0 [ AI_sub ] + CG.EmitInstr cgbuf (pop 1) Push0 (I_switch destinationLabels) else - error(InternalError("non-dense integer matches not implemented in codegen - these should have been removed by the pattern match compiler",switchm)); + error(InternalError("non-dense integer matches not implemented in codegen - these should have been removed by the pattern match compiler",switchm)) GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel | _ -> error(InternalError("these matches should never be needed",switchm)) and GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel = - assert(cgbuf.GetCurrentStack() = stackAtTargets); // cgbuf stack should be unchanged over tests. [bug://1750]. + assert(cgbuf.GetCurrentStack() = stackAtTargets) // cgbuf stack should be unchanged over tests. [bug://1750]. let targetInfos = match defaultTargetOpt with @@ -4385,17 +4407,17 @@ and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree match GetTarget targets n1, GetTarget targets n2 with | TTarget(_,BoolExpr(b1),_),_ -> - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue match tester with | Some (pops,pushes,i) -> match i with | Choice1Of2 (avoidHelpers,cuspec,idx) -> CG.EmitInstrs cgbuf pops pushes (EraseUnions.mkIsData cenv.g.ilg (avoidHelpers, cuspec, idx)) - | Choice2Of2 i -> CG.EmitInstr cgbuf pops pushes i; - | _ -> (); + | Choice2Of2 i -> CG.EmitInstr cgbuf pops pushes i + | _ -> () if not b1 then - CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_bool]) [mkLdcInt32 (0); ]; - CG.EmitInstrs cgbuf (pop 1) Push0 [AI_ceq]; - GenSequel cenv cloc cgbuf sequel; + CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_bool]) [mkLdcInt32 (0) ] + CG.EmitInstrs cgbuf (pop 1) Push0 [AI_ceq] + GenSequel cenv cloc cgbuf sequel targetInfos | _ -> failwith "internal error: GenDecisionTreeTest during bool elim" @@ -4405,11 +4427,11 @@ and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree match tester with | None -> // generate the expression, then test it for "false" - GenExpr cenv cgbuf eenv SPSuppress e (CmpThenBrOrContinue(pop 1, [ I_brcmp (BI_brfalse, failure.CodeLabel) ])); + GenExpr cenv cgbuf eenv SPSuppress e (CmpThenBrOrContinue(pop 1, [ I_brcmp (BI_brfalse, failure.CodeLabel) ])) // Turn 'isdata' tests that branch into EI_brisdata tests | Some (_,_,Choice1Of2 (avoidHelpers,cuspec,idx)) -> - GenExpr cenv cgbuf eenv SPSuppress e (CmpThenBrOrContinue(pop 1, EraseUnions.mkBrIsNotData cenv.g.ilg (avoidHelpers,cuspec, idx, failure.CodeLabel))); + GenExpr cenv cgbuf eenv SPSuppress e (CmpThenBrOrContinue(pop 1, EraseUnions.mkBrIsNotData cenv.g.ilg (avoidHelpers,cuspec, idx, failure.CodeLabel))) | Some (pops,pushes,i) -> GenExpr cenv cgbuf eenv SPSuppress e Continue @@ -4427,9 +4449,9 @@ and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree //------------------------------------------------------------------------- and GenLetRecFixup cenv cgbuf eenv (ilxCloSpec:IlxClosureSpec,e,ilField:ILFieldSpec,e2,_m) = - GenExpr cenv cgbuf eenv SPSuppress e Continue; - CG.EmitInstrs cgbuf (pop 0) Push0 [ I_castclass ilxCloSpec.ILType ]; - GenExpr cenv cgbuf eenv SPSuppress e2 Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue + CG.EmitInstrs cgbuf (pop 0) Push0 [ I_castclass ilxCloSpec.ILType ] + GenExpr cenv cgbuf eenv SPSuppress e2 Continue CG.EmitInstrs cgbuf (pop 2) Push0 [ mkNormalStfld (mkILFieldSpec(ilField.FieldRef,ilxCloSpec.ILType)) ] and GenLetRecBinds cenv cgbuf eenv (allBinds: Bindings,m) = @@ -4472,7 +4494,7 @@ and GenLetRecBinds cenv cgbuf eenv (allBinds: Bindings,m) = bind.Expr |> IterateRecursiveFixups cenv.g (Some bind.Var) (computeFixupsForOneRecursiveVar bind.Var forwardReferenceSet fixups) (exprForVal m bind.Var, - (fun _ -> failwith ("internal error: should never need to set non-delayed recursive val: " + bind.Var.LogicalName))); + (fun _ -> failwith ("internal error: should never need to set non-delayed recursive val: " + bind.Var.LogicalName))) // Record the variable as defined let forwardReferenceSet = Zset.remove bind.Var forwardReferenceSet forwardReferenceSet) @@ -4480,11 +4502,11 @@ and GenLetRecBinds cenv cgbuf eenv (allBinds: Bindings,m) = // Generate the actual bindings let _ = (recursiveVars, allBinds) ||> FlatList.fold (fun forwardReferenceSet (bind:Binding) -> - GenBind cenv cgbuf eenv bind; + GenBind cenv cgbuf eenv bind // Record the variable as defined let forwardReferenceSet = Zset.remove bind.Var forwardReferenceSet // Execute and discard any fixups that can now be committed - fixups := !fixups |> List.filter (fun (boundv, fv, action) -> if (Zset.contains boundv forwardReferenceSet || Zset.contains fv forwardReferenceSet) then true else (action(); false)); + fixups := !fixups |> List.filter (fun (boundv, fv, action) -> if (Zset.contains boundv forwardReferenceSet || Zset.contains fv forwardReferenceSet) then true else (action(); false)) forwardReferenceSet) () @@ -4492,7 +4514,7 @@ and GenLetRecBinds cenv cgbuf eenv (allBinds: Bindings,m) = and GenLetRec cenv cgbuf eenv (binds,body,m) sequel = let _,endScope as scopeMarks = StartLocalScope "letrec" cgbuf let eenv = AllocStorageForBinds cenv cgbuf scopeMarks eenv binds - GenLetRecBinds cenv cgbuf eenv (binds,m); + GenLetRecBinds cenv cgbuf eenv (binds,m) let sp = if FlatList.exists bindHasSeqPt binds || FlatList.forall bindIsInvisible binds then SPAlways else SPSuppress GenExpr cenv cgbuf eenv sp body (EndLocalScope(sequel,endScope)) @@ -4512,7 +4534,7 @@ and GenSequencePointForBind _cenv cgbuf eenv (TBind(vspec,e,spBind)) = // SEQUENCE POINT REVIEW: don't emit for lazy either, nor any builder expressions | _, (Expr.Lambda _ | Expr.TyLambda _) -> SPSuppress | SequencePointAtBinding m,_ -> - CG.EmitSeqPoint cgbuf m; + CG.EmitSeqPoint cgbuf m SPSuppress let m = vspec.Range @@ -4579,17 +4601,17 @@ and GenBindAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) = let ilAttribs = GenAttrs cenv eenv vspec.Attribs let ilTy = ilGetterMethSpec.FormalReturnType let ilPropDef = - { Name = PrettyNaming.ChopPropertyName ilGetterMethSpec.Name; - IsRTSpecialName = false; - IsSpecialName = false; - SetMethod = None; - GetMethod = Some ilGetterMethSpec.MethodRef; - CallingConv = ILThisConvention.Static; - Type = ilTy; - Init = None; - Args = mkILTypes []; + { Name = PrettyNaming.ChopPropertyName ilGetterMethSpec.Name + IsRTSpecialName = false + IsSpecialName = false + SetMethod = None + GetMethod = Some ilGetterMethSpec.MethodRef + CallingConv = ILThisConvention.Static + Type = ilTy + Init = None + Args = mkILTypes [] CustomAttrs = mkILCustomAttrs ilAttribs } - cgbuf.mgbuf.AddOrMergePropertyDef(ilGetterMethSpec.MethodRef.EnclosingTypeRef, ilPropDef,m); + cgbuf.mgbuf.AddOrMergePropertyDef(ilGetterMethSpec.MethodRef.EnclosingTypeRef, ilPropDef,m) let ilMethodDef = let ilMethodBody = MethodBody.IL(CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], ilGetterMethSpec.Name, eenv, 0, 0, rhsExpr, Return)) @@ -4597,13 +4619,13 @@ and GenBindAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) = |> AddSpecialNameFlag |> AddNonUserCompilerGeneratedAttribs cenv.g - CountMethodDef(); + CountMethodDef() cgbuf.mgbuf.AddMethodDef(ilGetterMethSpec.MethodRef.EnclosingTypeRef, ilMethodDef) match optShadowLocal with | NoShadowLocal -> () | ShadowLocal storage -> - CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)); + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)) GenSetStorage m cgbuf storage | StaticField (fspec, vref, hasLiteralAttr, ilTyForProperty, ilPropName, fty, ilGetterMethRef, ilSetterMethRef, optShadowLocal) -> @@ -4647,8 +4669,8 @@ and GenBindAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) = let ilTypeRefForProperty = ilTyForProperty.TypeRef for (tref,ilFieldDef) in ilFieldDefs do - cgbuf.mgbuf.AddFieldDef(tref,ilFieldDef); - CountStaticFieldDef(); + cgbuf.mgbuf.AddFieldDef(tref,ilFieldDef) + CountStaticFieldDef() // ... and the get/set properties to access it. if not hasLiteralAttr then @@ -4657,23 +4679,23 @@ and GenBindAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) = |> List.filter (fun (Attrib(_,_,_,_,_,targets,_)) -> canTarget(targets, System.AttributeTargets.Property)) |> GenAttrs cenv eenv // property only gets attributes that target properties let ilPropDef = - { Name=ilPropName; - IsRTSpecialName=false; - IsSpecialName=false; - SetMethod=if mut || cenv.opts.isInteractiveItExpr then Some ilSetterMethRef else None; - GetMethod=Some ilGetterMethRef; - CallingConv=ILThisConvention.Static; - Type=fty; - Init=None; - Args= mkILTypes []; - CustomAttrs=mkILCustomAttrs (ilAttribs @ [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Value)]); } - cgbuf.mgbuf.AddOrMergePropertyDef(ilTypeRefForProperty,ilPropDef,m); + { Name=ilPropName + IsRTSpecialName=false + IsSpecialName=false + SetMethod=if mut || cenv.opts.isInteractiveItExpr then Some ilSetterMethRef else None + GetMethod=Some ilGetterMethRef + CallingConv=ILThisConvention.Static + Type=fty + Init=None + Args= mkILTypes [] + CustomAttrs=mkILCustomAttrs (ilAttribs @ [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Value)]) } + cgbuf.mgbuf.AddOrMergePropertyDef(ilTypeRefForProperty,ilPropDef,m) let getterMethod = mkILStaticMethod([],ilGetterMethRef.Name,access,[],mkILReturn fty, mkMethodBody(true,emptyILLocals,2,nonBranchingInstrsToCode [ mkNormalLdsfld fspec ],None)) |> AddSpecialNameFlag - cgbuf.mgbuf.AddMethodDef(ilTypeRefForProperty,getterMethod) ; + cgbuf.mgbuf.AddMethodDef(ilTypeRefForProperty,getterMethod) if mut || cenv.opts.isInteractiveItExpr then let setterMethod = mkILStaticMethod([],ilSetterMethRef.Name,access,[mkILParamNamed("value",fty)],mkILReturn ILType.Void, @@ -4681,7 +4703,7 @@ and GenBindAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) = |> AddSpecialNameFlag cgbuf.mgbuf.AddMethodDef(ilTypeRefForProperty,setterMethod) - GenBindRhs cenv cgbuf eenv sp vspec rhsExpr; + GenBindRhs cenv cgbuf eenv sp vspec rhsExpr match optShadowLocal with | NoShadowLocal -> EmitSetStaticField cgbuf fspec @@ -4817,7 +4839,7 @@ and GenMarshal cenv attribs = | _ -> ILNativeType.Empty Some(decodeUnmanagedType unmanagedType), otherAttribs | Some (Attrib(_,_,_,_,_,_,m)) -> - errorR(Error(FSComp.SR.ilMarshalAsAttributeCannotBeDecoded(),m)); + errorR(Error(FSComp.SR.ilMarshalAsAttributeCannotBeDecoded(),m)) None, attribs | _ -> // No MarshalAs detected @@ -4870,13 +4892,13 @@ and GenParams cenv eenv (mspec:ILMethodSpec) (attribs:ArgReprInfo list) (implVal None, takenNames let param : ILParameter = - { Name=nmOpt; - Type= ilArgTy; - Default=None; (* REVIEW: support "default" attributes *) - Marshal=Marshal; - IsIn=inFlag; - IsOut=outFlag; - IsOptional=optionalFlag; + { Name=nmOpt + Type= ilArgTy + Default=None (* REVIEW: support "default" attributes *) + Marshal=Marshal + IsIn=inFlag + IsOut=outFlag + IsOptional=optionalFlag CustomAttrs= mkILCustomAttrs (GenAttrs cenv eenv attribs) } param, takenNames) @@ -4884,23 +4906,23 @@ and GenParams cenv eenv (mspec:ILMethodSpec) (attribs:ArgReprInfo list) (implVal and GenReturnInfo cenv eenv ilRetTy (retInfo : ArgReprInfo) : ILReturn = let marshal,attrs = GenMarshal cenv retInfo.Attribs - { Type=ilRetTy; - Marshal=marshal; + { Type=ilRetTy + Marshal=marshal CustomAttrs= mkILCustomAttrs (GenAttrs cenv eenv attrs) } and GenPropertyForMethodDef compileAsInstance tref mdef (v:Val) (memberInfo:ValMemberInfo) ilArgTys ilPropTy ilAttrs compiledName = let name = match compiledName with | Some n -> n | _ -> v.PropertyName in (* chop "get_" *) - { Name=name; - IsRTSpecialName=false; - IsSpecialName=false; - SetMethod=(if memberInfo.MemberFlags.MemberKind= MemberKind.PropertySet then Some(mkRefToILMethod(tref,mdef)) else None); - GetMethod=(if memberInfo.MemberFlags.MemberKind= MemberKind.PropertyGet then Some(mkRefToILMethod(tref,mdef)) else None); - CallingConv=(if compileAsInstance then ILThisConvention.Instance else ILThisConvention.Static); - Type=ilPropTy; - Init=None; - Args= mkILTypes ilArgTys; - CustomAttrs=ilAttrs; } + { Name=name + IsRTSpecialName=false + IsSpecialName=false + SetMethod=(if memberInfo.MemberFlags.MemberKind= MemberKind.PropertySet then Some(mkRefToILMethod(tref,mdef)) else None) + GetMethod=(if memberInfo.MemberFlags.MemberKind= MemberKind.PropertyGet then Some(mkRefToILMethod(tref,mdef)) else None) + CallingConv=(if compileAsInstance then ILThisConvention.Instance else ILThisConvention.Static) + Type=ilPropTy + Init=None + Args= mkILTypes ilArgTys + CustomAttrs=ilAttrs } and GenEventForProperty cenv eenvForMeth (mspec:ILMethodSpec) (v:Val) ilAttrsThatGoOnPrimaryItem m returnTy = let evname = v.PropertyName @@ -4909,15 +4931,15 @@ and GenEventForProperty cenv eenvForMeth (mspec:ILMethodSpec) (v:Val) ilAttrsTha let ilThisTy = mspec.EnclosingType let addMethRef = mkILMethRef (ilThisTy.TypeRef,mspec.CallingConv,"add_" + evname,0,[ilDelegateTy],ILType.Void) let removeMethRef = mkILMethRef (ilThisTy.TypeRef,mspec.CallingConv,"remove_" + evname,0,[ilDelegateTy],ILType.Void) - { Type = Some(ilDelegateTy); - Name= evname; - IsRTSpecialName=false; - IsSpecialName=false; - AddMethod = addMethRef; - RemoveMethod = removeMethRef; - FireMethod= None; - OtherMethods= []; - CustomAttrs = mkILCustomAttrs ilAttrsThatGoOnPrimaryItem; } + { Type = Some(ilDelegateTy) + Name= evname + IsRTSpecialName=false + IsSpecialName=false + AddMethod = addMethRef + RemoveMethod = removeMethRef + FireMethod= None + OtherMethods= [] + CustomAttrs = mkILCustomAttrs ilAttrsThatGoOnPrimaryItem } and ComputeFlagFixupsForMemberBinding cenv (v:Val,memberInfo:ValMemberInfo) = @@ -5020,12 +5042,12 @@ and GenMethodForBinding let hasPreserveSigNamedArg,ilMethodBody,_hasDllImport = match TryFindFSharpAttributeOpt cenv.g cenv.g.attrib_DllImportAttribute v.Attribs with | Some (Attrib(_,_,[ AttribStringArg(dll) ],namedArgs,_,_,m)) -> - if nonNil tps then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(),m)); + if nonNil tps then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(),m)) let hasPreserveSigNamedArg, mbody = GenPInvokeMethod (v.CompiledName,dll,namedArgs) hasPreserveSigNamedArg, mbody, true | Some (Attrib(_,_,_,_,_,_,m)) -> - error(Error(FSComp.SR.ilDllImportAttributeCouldNotBeDecoded(),m)); + error(Error(FSComp.SR.ilDllImportAttributeCouldNotBeDecoded(),m)) | _ -> // Replace the body of ValInline.PseudoVal "must inline" methods with a 'throw' // However still generate the code for reflection etc. @@ -5084,10 +5106,10 @@ and GenMethodForBinding let mdef = {mdef with - IsPreserveSig = hasPreserveSigImplFlag || hasPreserveSigNamedArg; - IsSynchronized = hasSynchronizedImplFlag; - IsEntryPoint = isExplicitEntryPoint; - IsNoInline = hasNoInliningFlag; + IsPreserveSig = hasPreserveSigImplFlag || hasPreserveSigNamedArg + IsSynchronized = hasSynchronizedImplFlag + IsEntryPoint = isExplicitEntryPoint + IsNoInline = hasNoInliningFlag HasSecurity = mdef.HasSecurity || (securityAttributes.Length > 0) SecurityDecls = secDecls } @@ -5101,7 +5123,7 @@ and GenMethodForBinding {mdef with IsSpecialName=true} else mdef - CountMethodDef(); + CountMethodDef() cgbuf.mgbuf.AddMethodDef(tref,mdef) @@ -5116,13 +5138,13 @@ and GenMethodForBinding if memberInfo.MemberFlags.MemberKind = MemberKind.Constructor then assert (isNil ilMethTypars) let mdef = mkILCtor (access,ilParams,ilMethodBody) - let mdef = { mdef with CustomAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated) }; + let mdef = { mdef with CustomAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated) } EmitTheMethodDef mdef elif memberInfo.MemberFlags.MemberKind = MemberKind.ClassConstructor then assert (isNil ilMethTypars) let mdef = mkILClassCtor ilMethodBody - let mdef = { mdef with CustomAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated) }; + let mdef = { mdef with CustomAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated) } EmitTheMethodDef mdef // Generate virtual/override methods + method-impl information if needed @@ -5153,15 +5175,15 @@ and GenMethodForBinding {mdef with mdKind=match mdef.mdKind with | MethodKind.Virtual vinfo -> - MethodKind.Virtual {vinfo with IsFinal=memberInfo.MemberFlags.IsFinal; - IsAbstract=isAbstract; } + MethodKind.Virtual {vinfo with IsFinal=memberInfo.MemberFlags.IsFinal + IsAbstract=isAbstract } | k -> k } match memberInfo.MemberFlags.MemberKind with | (MemberKind.PropertySet | MemberKind.PropertyGet) -> if nonNil ilMethTypars then - error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression",v.Range)); + error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression",v.Range)) // Check if we're compiling the property as a .NET event if CompileAsEvent cenv.g v.Attribs then @@ -5183,10 +5205,10 @@ and GenMethodForBinding // Add the special name flag for all properties let mdef = mdef |> AddSpecialNameFlag - let mdef = { mdef with CustomAttrs= mkILCustomAttrs ((GenAttrs cenv eenv attrsAppliedToGetterOrSetter) @ sourceNameAttribs @ ilAttrsCompilerGenerated) }; + let mdef = { mdef with CustomAttrs= mkILCustomAttrs ((GenAttrs cenv eenv attrsAppliedToGetterOrSetter) @ sourceNameAttribs @ ilAttrsCompilerGenerated) } EmitTheMethodDef mdef | _ -> - let mdef = { mdef with CustomAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated) }; + let mdef = { mdef with CustomAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated) } EmitTheMethodDef mdef | _ -> @@ -5210,11 +5232,11 @@ and GenMethodForBinding and GenPInvokeMethod (nm,dll,namedArgs) = let decoder = AttributeDecoder namedArgs - let hasPreserveSigNamedArg = decoder.FindBool "PreserveSig" true; + let hasPreserveSigNamedArg = decoder.FindBool "PreserveSig" true hasPreserveSigNamedArg, MethodBody.PInvoke - { Where=mkSimpleModRef dll; - Name=decoder.FindString "EntryPoint" nm; + { Where=mkSimpleModRef dll + Name=decoder.FindString "EntryPoint" nm CallingConv= match decoder.FindInt32 "CallingConvention" 0 with | 1 -> PInvokeCallingConvention.WinApi @@ -5222,17 +5244,17 @@ and GenPInvokeMethod (nm,dll,namedArgs) = | 3 -> PInvokeCallingConvention.Stdcall | 4 -> PInvokeCallingConvention.Thiscall | 5 -> PInvokeCallingConvention.Fastcall - | _ -> PInvokeCallingConvention.WinApi; + | _ -> PInvokeCallingConvention.WinApi CharEncoding= match decoder.FindInt32 "CharSet" 0 with | 1 -> PInvokeCharEncoding.None | 2 -> PInvokeCharEncoding.Ansi | 3 -> PInvokeCharEncoding.Unicode | 4 -> PInvokeCharEncoding.Auto - | _ -> PInvokeCharEncoding.None; - NoMangle= decoder.FindBool "ExactSpelling" false; - LastError= decoder.FindBool "SetLastError" false; - ThrowOnUnmappableChar= if (decoder.FindBool "ThrowOnUnmappableChar" false) then PInvokeThrowOnUnmappableChar.Enabled else PInvokeThrowOnUnmappableChar.UseAssembly; + | _ -> PInvokeCharEncoding.None + NoMangle= decoder.FindBool "ExactSpelling" false + LastError= decoder.FindBool "SetLastError" false + ThrowOnUnmappableChar= if (decoder.FindBool "ThrowOnUnmappableChar" false) then PInvokeThrowOnUnmappableChar.Enabled else PInvokeThrowOnUnmappableChar.UseAssembly CharBestFit=if (decoder.FindBool "BestFitMapping" false) then PInvokeCharBestFit.Enabled else PInvokeCharBestFit.UseAssembly } @@ -5246,10 +5268,10 @@ and GenSetVal cenv cgbuf eenv (vref,e,m) sequel = let storage = StorageForValRef m vref eenv match storage with | Env (ilCloTy,_,_,_) -> - CG.EmitInstr cgbuf (pop 0) (Push [ilCloTy]) mkLdarg0; + CG.EmitInstr cgbuf (pop 0) (Push [ilCloTy]) mkLdarg0 | _ -> () - GenExpr cenv cgbuf eenv SPSuppress e Continue; + GenExpr cenv cgbuf eenv SPSuppress e Continue GenSetStorage vref.Range cgbuf storage GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel @@ -5258,7 +5280,7 @@ and GenGetValRefAndSequel cenv cgbuf eenv m (v:ValRef) fetchSequel = GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m cenv.g eenv.tyenv ty) (StorageForValRef m v eenv) fetchSequel and GenGetVal cenv cgbuf eenv (v:ValRef,m) sequel = - GenGetValRefAndSequel cenv cgbuf eenv m v None; + GenGetValRefAndSequel cenv cgbuf eenv m v None GenSequel cenv eenv.cloc cgbuf sequel and GenBindRhs cenv cgbuf eenv sp (vspec:Val) e = @@ -5277,10 +5299,10 @@ and GenBindRhs cenv cgbuf eenv sp (vspec:Val) e = let selfv = if isLocalTypeFunc then None else Some (mkLocalValRef vspec) GenLambda cenv cgbuf eenv isLocalTypeFunc selfv e Continue | _ -> - GenExpr cenv cgbuf eenv sp e Continue; + GenExpr cenv cgbuf eenv sp e Continue and GenSetBindValue cenv cgbuf eenv eenv2 (vspec:Val) e = - GenBindRhs cenv cgbuf eenv2 SPSuppress vspec e; + GenBindRhs cenv cgbuf eenv2 SPSuppress vspec e GenStoreVal cgbuf eenv vspec.Range vspec and EmitInitLocal cgbuf typ idx = CG.EmitInstrs cgbuf (pop 0) Push0 [I_ldloca (uint16 idx); (I_initobj typ) ] @@ -5294,7 +5316,7 @@ and GenSetStorage m cgbuf storage = match storage with | Local (idx,_) -> EmitSetLocal cgbuf idx | StaticField (_, _, hasLiteralAttr, ilContainerTy, _, _, _, ilSetterMethRef, _) -> - if hasLiteralAttr then errorR(Error(FSComp.SR.ilLiteralFieldsCannotBeSet(),m)); + if hasLiteralAttr then errorR(Error(FSComp.SR.ilLiteralFieldsCannotBeSet(),m)) CG.EmitInstr cgbuf (pop 1) Push0 (I_call(Normalcall,mkILMethSpecForMethRefInTy(ilSetterMethRef,ilContainerTy,[]),None)) | StaticProperty (ilGetterMethSpec,_) -> error(Error(FSComp.SR.ilStaticMethodIsNotLambda(ilGetterMethSpec.Name),m)) @@ -5313,7 +5335,7 @@ and CommitGetStorageSequel cenv cgbuf eenv m typ localCloInfo storeSequel = match localCloInfo,storeSequel with | Some {contents =NamedLocalIlxClosureInfoGenerator _cloinfo},_ -> error(InternalError("Unexpected generator",m)) | Some {contents =NamedLocalIlxClosureInfoGenerated cloinfo},Some (tyargs,args,m,sequel) when nonNil tyargs -> - let actualRetTy = GenNamedLocalTyFuncCall cenv cgbuf eenv typ cloinfo tyargs m; + let actualRetTy = GenNamedLocalTyFuncCall cenv cgbuf eenv typ cloinfo tyargs m CommitGetStorageSequel cenv cgbuf eenv m actualRetTy None (Some ([],args,m,sequel)) | _, None -> () | _,Some ([],[],_,sequel) -> @@ -5324,7 +5346,7 @@ and CommitGetStorageSequel cenv cgbuf eenv m typ localCloInfo storeSequel = and GenGetStorageAndSequel cenv cgbuf eenv m (typ,ilTy) storage storeSequel = match storage with | Local (idx,localCloInfo) -> - EmitGetLocal cgbuf ilTy idx; + EmitGetLocal cgbuf ilTy idx CommitGetStorageSequel cenv cgbuf eenv m typ localCloInfo storeSequel | StaticField (fspec, _, hasLiteralAttr, ilContainerTy, _, _, ilGetterMethRef, _, _) -> @@ -5332,11 +5354,11 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (typ,ilTy) storage storeSequel = if hasLiteralAttr then EmitGetStaticField cgbuf ilTy fspec else - CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call(Normalcall, mkILMethSpecForMethRefInTy (ilGetterMethRef, ilContainerTy, []), None)); + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call(Normalcall, mkILMethSpecForMethRefInTy (ilGetterMethRef, ilContainerTy, []), None)) CommitGetStorageSequel cenv cgbuf eenv m typ None storeSequel | StaticProperty (ilGetterMethSpec, _) -> - CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)); + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)) CommitGetStorageSequel cenv cgbuf eenv m typ None storeSequel | Method (topValInfo,vref,mspec,_,_,_) -> @@ -5355,19 +5377,19 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (typ,ilTy) storage storeSequel = GenLambda cenv cgbuf eenv false None expr Continue | Some (tyargs',args,m,sequel) -> let specializedExpr = - if isNil args && isNil tyargs' then failwith ("non-lambda at use of method " + mspec.Name); + if isNil args && isNil tyargs' then failwith ("non-lambda at use of method " + mspec.Name) MakeApplicationAndBetaReduce cenv.g (expr,exprty,[tyargs'],args,m) GenExpr cenv cgbuf eenv SPSuppress specializedExpr sequel | Null -> - CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldnull); + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldnull) CommitGetStorageSequel cenv cgbuf eenv m typ None storeSequel | Unrealized -> - error(InternalError(sprintf "getting an unrealized value of type '%s'" (showL(typeL typ)),m)); + error(InternalError(sprintf "getting an unrealized value of type '%s'" (showL(typeL typ)),m)) | Arg i -> - CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdarg (uint16 i)); + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdarg (uint16 i)) CommitGetStorageSequel cenv cgbuf eenv m typ None storeSequel | Env (_,_,ilField,localCloInfo) -> @@ -5376,7 +5398,7 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (typ,ilTy) storage storeSequel = CommitGetStorageSequel cenv cgbuf eenv m typ localCloInfo storeSequel and GenGetLocalVals cenv cgbuf eenvouter m fvs = - List.iter (fun v -> GenGetLocalVal cenv cgbuf eenvouter m v None) fvs; + List.iter (fun v -> GenGetLocalVal cenv cgbuf eenvouter m v None) fvs and GenGetLocalVal cenv cgbuf eenv m (vspec:Val) fetchSequel = GenGetStorageAndSequel cenv cgbuf eenv m (vspec.Type, GenTypeOfVal cenv eenv vspec) (StorageForVal m vspec eenv) fetchSequel @@ -5391,14 +5413,14 @@ and GenStoreVal cgbuf eenv m (vspec:Val) = // Allocate locals for values //-------------------------------------------------------------------------- -and AllocLocal cenv cgbuf eenv compgen (v,ty) (scopeMarks: Mark * Mark) = +and AllocLocal cenv cgbuf eenv compgen (v,ty,isFixed) (scopeMarks: Mark * Mark) = // The debug range for the local let ranges = if compgen then [] else [(v,scopeMarks)] // Get an index for the local let j = if cenv.opts.localOptimizationsAreOn - then cgbuf.ReallocLocal((fun i (_,ty') -> not (IntMap.mem i eenv.liveLocals) && (ty = ty')),ranges,ty) - else cgbuf.AllocLocal(ranges,ty) + then cgbuf.ReallocLocal((fun i (_,ty',isFixed') -> not isFixed' && not isFixed && not (IntMap.mem i eenv.liveLocals) && (ty = ty')),ranges,ty,isFixed) + else cgbuf.AllocLocal(ranges,ty,isFixed) j, { eenv with liveLocals = IntMap.add j () eenv.liveLocals } and AllocLocalVal cenv cgbuf v eenv repr scopeMarks = @@ -5414,11 +5436,11 @@ and AllocLocalVal cenv cgbuf v eenv repr scopeMarks = let cloinfo,_,_ = GetIlxClosureInfo cenv v.Range true None eenvinner (Option.get repr) cloinfo - let idx,eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, cenv.g.ilg.typ_Object) scopeMarks + let idx,eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, cenv.g.ilg.typ_Object, false) scopeMarks Local (idx,Some(ref (NamedLocalIlxClosureInfoGenerator cloinfoGenerate))),eenv else (* normal local *) - let idx,eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, GenTypeOfVal cenv eenv v) scopeMarks + let idx,eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, GenTypeOfVal cenv eenv v, v.IsFixed) scopeMarks Local (idx,None),eenv let eenv = AddStorageForVal cenv.g (v,notlazy repr) eenv Some repr, eenv @@ -5443,7 +5465,7 @@ and AllocStorageForBinds cenv cgbuf scopeMarks eenv binds = | NamedLocalIlxClosureInfoGenerator f -> g := NamedLocalIlxClosureInfoGenerated (f eenv) | NamedLocalIlxClosureInfoGenerated _ -> () | _ -> () - | _ -> ()); + | _ -> ()) eenv @@ -5488,14 +5510,14 @@ and AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v eenv = /// - and because IL requires empty stack following a forward br (jump). and EmitSaveStack cenv cgbuf eenv m scopeMarks = let savedStack = (cgbuf.GetCurrentStack()) - let savedStackLocals,eenvinner = List.mapFold (fun eenv ty -> AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("spill",m), ty) scopeMarks) eenv savedStack - List.iter (EmitSetLocal cgbuf) savedStackLocals; - cgbuf.AssertEmptyStack(); + let savedStackLocals,eenvinner = List.mapFold (fun eenv ty -> AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("spill",m), ty, false) scopeMarks) eenv savedStack + List.iter (EmitSetLocal cgbuf) savedStackLocals + cgbuf.AssertEmptyStack() (savedStack,savedStackLocals),eenvinner (* need to return, it marks locals "live" *) /// Restore the stack and load the result and EmitRestoreStack cgbuf (savedStack,savedStackLocals) = - cgbuf.AssertEmptyStack(); + cgbuf.AssertEmptyStack() List.iter2 (EmitGetLocal cgbuf) (List.rev savedStack) (List.rev savedStackLocals) //------------------------------------------------------------------------- @@ -5595,7 +5617,7 @@ and GenAttr amap g eenv (Attrib(_,k,args,props,_,_,_)) = match k with | ILAttrib(mref) -> mkILMethSpec(mref,AsObject,[],[]) | FSAttrib(vref) -> - assert(vref.IsMember); + assert(vref.IsMember) let mspec,_,_,_,_ = GetMethodSpecForMemberVal amap g (Option.get vref.MemberInfo) vref mspec let ilArgs = List.map2 (fun (AttribExpr(_,vexpr)) ty -> GenAttribArg amap g eenv vexpr ty) args (ILList.toList mspec.FormalArgTypes) @@ -5683,7 +5705,7 @@ and GenModuleDef cenv (cgbuf:CodeGenBuffer) qname lazyInitInfo eenv x = GenBindings cenv cgbuf eenv (FlatList.one bind) | TMDefDo(e,_) -> - GenExpr cenv cgbuf eenv SPAlways e discard; + GenExpr cenv cgbuf eenv SPAlways e discard | TMAbstract(mexpr) -> GenModuleExpr cenv cgbuf qname lazyInitInfo eenv mexpr @@ -5696,7 +5718,7 @@ and GenModuleDef cenv (cgbuf:CodeGenBuffer) qname lazyInitInfo eenv x = and GenModuleBinding cenv (cgbuf:CodeGenBuffer) (qname:QualifiedNameOfFile) lazyInitInfo eenv m x = match x with | ModuleOrNamespaceBinding.Binding bind -> - GenLetRecBinds cenv cgbuf eenv ([bind],m); + GenLetRecBinds cenv cgbuf eenv ([bind],m) | ModuleOrNamespaceBinding.Module (mspec, mdef) -> let hidden = IsHiddenTycon eenv.sigToImplRemapInfo mspec @@ -5716,16 +5738,16 @@ and GenModuleBinding cenv (cgbuf:CodeGenBuffer) (qname:QualifiedNameOfFile) lazy // "main" method in the case where the "main" method is implicit. let staticClassTrigger = (* if eenv.isFinalFile then *) ILTypeInit.OnAny (* else ILTypeInit.BeforeField *) - GenTypeDefForCompLoc (cenv, eenvinner, cgbuf.mgbuf, eenvinner.cloc, hidden, mspec.Attribs, staticClassTrigger, false, (* atEnd= *) true); + GenTypeDefForCompLoc (cenv, eenvinner, cgbuf.mgbuf, eenvinner.cloc, hidden, mspec.Attribs, staticClassTrigger, false, (* atEnd= *) true) // Generate the declarations in the module and its initialization code - GenModuleDef cenv cgbuf qname lazyInitInfo eenvinner mdef; + GenModuleDef cenv cgbuf qname lazyInitInfo eenvinner mdef // If the module has a .cctor for some mutable fields, we need to ensure that when // those fields are "touched" the InitClass .cctor is forced. The InitClass .cctor will // then fill in the value of the mutable fields. if not mspec.IsNamespace && (cgbuf.mgbuf.GetCurrentFields(TypeRefForCompLoc eenvinner.cloc) |> Seq.isEmpty |> not) then - GenForceWholeFileInitializationAsPartOfCCtor cenv cgbuf.mgbuf lazyInitInfo (TypeRefForCompLoc eenvinner.cloc) mspec.Range; + GenForceWholeFileInitializationAsPartOfCCtor cenv cgbuf.mgbuf lazyInitInfo (TypeRefForCompLoc eenvinner.cloc) mspec.Range /// Generate the namespace fragments in a single file @@ -5740,14 +5762,14 @@ and GenTopImpl cenv mgbuf mainInfoOpt eenv (TImplFile(qname, _, mexpr, hasExplic let initClassTrigger = (* if isFinalFile then *) ILTypeInit.OnAny (* else ILTypeInit.BeforeField *) - let eenv = {eenv with cloc = initClassCompLoc; - isFinalFile = isFinalFile; + let eenv = {eenv with cloc = initClassCompLoc + isFinalFile = isFinalFile someTypeInThisAssembly = initClassTy } // Create the class to hold the initialization code and static fields for this file. // internal static class $ {} // Put it at the end since that gives an approximation of dependency order (to aid FSI.EXE's code generator - see FSharp 1.0 5548) - GenTypeDefForCompLoc (cenv, eenv, mgbuf, initClassCompLoc, useHiddenInitCode, [], initClassTrigger, false, (*atEnd=*)true); + GenTypeDefForCompLoc (cenv, eenv, mgbuf, initClassCompLoc, useHiddenInitCode, [], initClassTrigger, false, (*atEnd=*)true) // lazyInitInfo is an accumulator of functions which add the forced initialization of the storage module to // - mutable fields in public modules @@ -5775,7 +5797,7 @@ and GenTopImpl cenv mgbuf mainInfoOpt eenv (TImplFile(qname, _, mexpr, hasExplic CodeGenMethod cenv mgbuf (true,[],methodName,eenv,0,0, (fun cgbuf eenv -> - GenModuleExpr cenv cgbuf qname lazyInitInfo eenv mexpr; + GenModuleExpr cenv cgbuf qname lazyInitInfo eenv mexpr CG.EmitInstr cgbuf (pop 0) Push0 I_ret),m) // The code generation for the initialization is now complete and the IL code is in topCode. @@ -5813,10 +5835,10 @@ and GenTopImpl cenv mgbuf mainInfoOpt eenv (TImplFile(qname, _, mexpr, hasExplic if doesSomething then lazyInitInfo.Add (fun fspec feefee seqpt -> // This adds the explicit init of the .cctor to the explicit entrypoint main method - mgbuf.AddExplicitInitToSpecificMethodDef((fun md -> md.IsEntryPoint), tref, fspec, GenPossibleILSourceMarker cenv m, feefee, seqpt)); + mgbuf.AddExplicitInitToSpecificMethodDef((fun md -> md.IsEntryPoint), tref, fspec, GenPossibleILSourceMarker cenv m, feefee, seqpt)) let cctorMethDef = mkILClassCtor (MethodBody.IL topCode) - mgbuf.AddMethodDef(initClassTy.TypeRef,cctorMethDef); + mgbuf.AddMethodDef(initClassTy.TypeRef,cctorMethDef) // Final file, implicit entry point. We generate no .cctor. // void main@() { @@ -5827,14 +5849,14 @@ and GenTopImpl cenv mgbuf mainInfoOpt eenv (TImplFile(qname, _, mexpr, hasExplic let ilAttrs = mkILCustomAttrs (GenAttrs cenv eenv mainInfo) if not cenv.opts.isInteractive && not doesSomething then let errorM = m.EndRange - warning (Error(FSComp.SR.ilMainModuleEmpty(), errorM)); + warning (Error(FSComp.SR.ilMainModuleEmpty(), errorM)) // generate main@ let ilMainMethodDef = let mdef = mkILNonGenericStaticMethod(mainMethName,ILMemberAccess.Public,[],mkILReturn ILType.Void, MethodBody.IL topCode) {mdef with IsEntryPoint= true; CustomAttrs = ilAttrs } - mgbuf.AddMethodDef(initClassTy.TypeRef,ilMainMethodDef); + mgbuf.AddMethodDef(initClassTy.TypeRef,ilMainMethodDef) // Library file : generate an optional .cctor if topCode has initialization effect @@ -5843,7 +5865,7 @@ and GenTopImpl cenv mgbuf mainInfoOpt eenv (TImplFile(qname, _, mexpr, hasExplic // Add the cctor let cctorMethDef = mkILClassCtor (MethodBody.IL topCode) - mgbuf.AddMethodDef(initClassTy.TypeRef,cctorMethDef); + mgbuf.AddMethodDef(initClassTy.TypeRef,cctorMethDef) end @@ -5860,12 +5882,12 @@ and GenTopImpl cenv mgbuf mainInfoOpt eenv (TImplFile(qname, _, mexpr, hasExplic |> addFieldGeneratedAttrs cenv.g.ilg let fspec = mkILFieldSpecInTy (initClassTy, initFieldName, cenv. g.ilg.typ_Int32) - CountStaticFieldDef(); - mgbuf.AddFieldDef(initClassTy.TypeRef,ilFieldDef); + CountStaticFieldDef() + mgbuf.AddFieldDef(initClassTy.TypeRef,ilFieldDef) // Run the imperative (yuck!) actions that force the generation // of references to the cctor for nested modules etc. - lazyInitInfo |> Seq.iter (fun f -> f fspec feefee seqpt); + lazyInitInfo |> Seq.iter (fun f -> f fspec feefee seqpt) if isScript && not(isFinalFile) then mgbuf.AddScriptInitFieldSpec(fspec,m) @@ -5895,8 +5917,8 @@ and GenEqualsOverrideCallingIComparable cenv (tcref:TyconRef, ilThisTy, _ilThatT mkILReturn cenv.g.ilg.typ_bool, mkMethodBody(true,emptyILLocals,2, nonBranchingInstrsToCode - [ yield mkLdarg0; - yield mkLdarg 1us; + [ yield mkLdarg0 + yield mkLdarg 1us if tcref.IsStructOrEnumTycon then yield I_callconstraint ( Normalcall, ilThisTy,mspec,None) else @@ -5926,7 +5948,7 @@ and GenFieldInit m c = and GenAbstractBinding cenv eenv tref (vref:ValRef) = - assert(vref.IsMember); + assert(vref.IsMember) let m = vref.Range let memberInfo = Option.get vref.MemberInfo let attribs = vref.Attribs @@ -5948,13 +5970,13 @@ and GenAbstractBinding cenv eenv tref (vref:ValRef) = let mdef = fixupVirtualSlotFlags mdef let mdef = {mdef with - IsPreserveSig=hasPreserveSigImplFlag; - IsSynchronized=hasSynchronizedImplFlag; - IsNoInline=hasNoInliningFlag; + IsPreserveSig=hasPreserveSigImplFlag + IsSynchronized=hasSynchronizedImplFlag + IsNoInline=hasNoInliningFlag mdKind=match mdef.mdKind with | MethodKind.Virtual vinfo -> - MethodKind.Virtual {vinfo with IsFinal=memberInfo.MemberFlags.IsFinal; - IsAbstract=memberInfo.MemberFlags.IsDispatchSlot; } + MethodKind.Virtual {vinfo with IsFinal=memberInfo.MemberFlags.IsFinal + IsAbstract=memberInfo.MemberFlags.IsDispatchSlot } | k -> k } match memberInfo.MemberFlags.MemberKind with @@ -5963,7 +5985,7 @@ and GenAbstractBinding cenv eenv tref (vref:ValRef) = | MemberKind.Member -> let mdef = {mdef with CustomAttrs= mkILCustomAttrs ilAttrs } [mdef], [], [] - | MemberKind.PropertyGetSet -> error(Error(FSComp.SR.ilUnexpectedGetSetAnnotation(),m)); + | MemberKind.PropertyGetSet -> error(Error(FSComp.SR.ilUnexpectedGetSetAnnotation(),m)) | MemberKind.PropertySet | MemberKind.PropertyGet -> let v = vref.Deref let vtyp = ReturnTypeOfPropertyVal cenv.g v @@ -6046,7 +6068,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = // REVIEW: no method impl generated for IStructuralHash or ICompare let methodImpls = [ for vref in tycon.MembersOfFSharpTyconByName |> NameMultiMap.range do - assert(vref.IsMember); + assert(vref.IsMember) let memberInfo = vref.MemberInfo.Value if memberInfo.MemberFlags.IsOverrideOrExplicitImpl && not (CompileAsEvent cenv.g vref.Attribs) then @@ -6122,7 +6144,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | TTyconInterface -> ILTypeDefKind.Interface | TTyconEnum -> ILTypeDefKind.Enum | TTyconDelegate _ -> ILTypeDefKind.Delegate - | TRecdRepr _ when tycon.IsStructRecordTycon -> ILTypeDefKind.ValueType + | TRecdRepr _ | TUnionRepr _ when tycon.IsStructOrEnumTycon -> ILTypeDefKind.ValueType | _ -> ILTypeDefKind.Class let requiresExtraField = @@ -6164,7 +6186,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | Some (Attrib(_,_,[ AttribInt32Arg(fieldOffset) ],_,_,_,_)) -> Some fieldOffset | Some (Attrib(_,_,_,_,_,_,m)) -> - errorR(Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded(),m)); + errorR(Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded(),m)) None | _ -> None @@ -6198,18 +6220,18 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | _ -> [] // don't hide fields in classes in debug display yield - { Name = ilFieldName; - Type = ilPropType; - IsStatic = isStatic; - Access = ComputeMemberAccess isFieldHidden; - Data = None; - LiteralValue = Option.map (GenFieldInit m) fspec.LiteralValue; - Offset = ilFieldOffset; - IsSpecialName = (ilFieldName="value__" && tycon.IsEnumTycon); + { Name = ilFieldName + Type = ilPropType + IsStatic = isStatic + Access = ComputeMemberAccess isFieldHidden + Data = None + LiteralValue = Option.map (GenFieldInit m) fspec.LiteralValue + Offset = ilFieldOffset + IsSpecialName = (ilFieldName="value__" && tycon.IsEnumTycon) Marshal = ilFieldMarshal - NotSerialized = ilNotSerialized; - IsInitOnly = false; - IsLiteral = fspec.LiteralValue.IsSome; + NotSerialized = ilNotSerialized + IsInitOnly = false + IsLiteral = fspec.LiteralValue.IsSome CustomAttrs = mkILCustomAttrs (GenAttrs cenv eenv fattribs @ extraAttribs) } if requiresExtraField then @@ -6224,16 +6246,16 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let ilHasSetter = isCLIMutable || isFSharpMutable let ilFieldAttrs = GenAttrs cenv eenv propAttribs @ [mkCompilationMappingAttrWithSeqNum cenv.g (int SourceConstructFlags.Field) i] yield - { Name = ilPropName; - IsRTSpecialName = false; - IsSpecialName = false; - SetMethod = (if ilHasSetter then Some(mkILMethRef(tref,ilCallingConv,"set_" + ilPropName,0,[ilPropType],ILType.Void)) else None); - GetMethod = Some(mkILMethRef(tref,ilCallingConv,"get_" + ilPropName,0,[],ilPropType)); - CallingConv = ilCallingConv.ThisConv; - Type = ilPropType; - Init = None; - Args = mkILTypes []; - CustomAttrs = mkILCustomAttrs ilFieldAttrs; } ] + { Name = ilPropName + IsRTSpecialName = false + IsSpecialName = false + SetMethod = (if ilHasSetter then Some(mkILMethRef(tref,ilCallingConv,"set_" + ilPropName,0,[ilPropType],ILType.Void)) else None) + GetMethod = Some(mkILMethRef(tref,ilCallingConv,"get_" + ilPropName,0,[],ilPropType)) + CallingConv = ilCallingConv.ThisConv + Type = ilPropType + Init = None + Args = mkILTypes [] + CustomAttrs = mkILCustomAttrs ilFieldAttrs } ] let methodDefs = [ // Generate property getter methods for those fields that have properties @@ -6275,11 +6297,11 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = // Give the instantiation of the printf format object, i.e. a Format`5 object compatible with StringFormat let newFormatMethSpec = mkILMethSpec(newFormatMethSpec.MethodRef,AsObject, [// 'T -> string' - funcTy; + funcTy // rest follow from 'StringFormat' - GenUnitTy cenv eenv m; - cenv.g.ilg.typ_String; - cenv.g.ilg.typ_String; + GenUnitTy cenv eenv m + cenv.g.ilg.typ_String + cenv.g.ilg.typ_String cenv.g.ilg.typ_String],[]) // Instantiate with our own type let sprintfMethSpec = mkILMethSpec(sprintfMethSpec.MethodRef,AsObject,[],[funcTy]) @@ -6291,13 +6313,15 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = (true,emptyILLocals,2, nonBranchingInstrsToCode ([ // load the hardwired format string - I_ldstr "%+0.8A"; + yield I_ldstr "%+0.8A" // make the printf format object - mkNormalNewobj newFormatMethSpec; + yield mkNormalNewobj newFormatMethSpec // call sprintf - mkNormalCall sprintfMethSpec; + yield mkNormalCall sprintfMethSpec // call the function returned by sprintf - mkLdarg0 ] @ + yield mkLdarg0 + if ilThisTy.Boxity = ILBoxity.AsValue then + yield mkNormalLdobj ilThisTy ] @ callInstrs), None)) yield ilMethodDef |> AddSpecialNameFlag |> AddNonUserCompilerGeneratedAttribs cenv.g @@ -6325,7 +6349,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = relevantFields |> List.map (fun (_,ilFieldName,_,_,_,ilPropType,_,fspec) -> (fspec.Name,ilFieldName,ilPropType)) - let isStructRecord = tycon.IsStructRecordTycon + let isStructRecord = tycon.IsStructRecordOrUnionTycon // No type spec if the record is a value type let spec = if isStructRecord then None else Some(cenv.g.ilg.tspec_Object) @@ -6412,10 +6436,10 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = // Set some the extra entries in the definition let isTheSealedAttribute = tyconRefEq cenv.g tcref cenv.g.attrib_SealedAttribute.TyconRef - let tdef = { tdef with IsSealed = isSealedTy cenv.g thisTy || isTheSealedAttribute; - IsSerializable = isSerializable; - MethodImpls=mkILMethodImpls methodImpls; - IsAbstract=isAbstract; + let tdef = { tdef with IsSealed = isSealedTy cenv.g thisTy || isTheSealedAttribute + IsSerializable = isSerializable + MethodImpls=mkILMethodImpls methodImpls + IsAbstract=isAbstract IsComInterop=isComInteropTy cenv.g thisTy } let tdLayout,tdEncoding = @@ -6442,7 +6466,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | _ -> ILTypeDefLayout.Auto tdLayout,tdEncoding | Some (Attrib(_,_,_,_,_,_,m)) -> - errorR(Error(FSComp.SR.ilStructLayoutAttributeCouldNotBeDecoded(),m)); + errorR(Error(FSComp.SR.ilStructLayoutAttributeCouldNotBeDecoded(),m)) ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi | _ when (match ilTypeDefKind with ILTypeDefKind.ValueType -> true | _ -> false) -> @@ -6486,46 +6510,46 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | TUnionRepr _ -> let alternatives = tycon.UnionCasesArray |> Array.mapi (fun i ucspec -> - { altName=ucspec.CompiledName; - altFields=GenUnionCaseRef cenv.amap m cenv.g eenvinner.tyenv i ucspec.RecdFieldsArray; + { altName=ucspec.CompiledName + altFields=GenUnionCaseRef cenv.amap m cenv.g eenvinner.tyenv i ucspec.RecdFieldsArray altCustomAttrs= mkILCustomAttrs (GenAttrs cenv eenv ucspec.Attribs @ [mkCompilationMappingAttrWithSeqNum cenv.g (int SourceConstructFlags.UnionCase) i]) }) let cuinfo = - { cudReprAccess=reprAccess; - cudNullPermitted=IsUnionTypeWithNullAsTrueValue cenv.g tycon; - cudHelpersAccess=reprAccess; - cudHasHelpers=ComputeUnionHasHelpers cenv.g tcref; - cudDebugProxies= generateDebugProxies; - cudDebugDisplayAttributes= ilDebugDisplayAttributes; - cudAlternatives= alternatives; - cudWhere = None}; + { cudReprAccess=reprAccess + cudNullPermitted=IsUnionTypeWithNullAsTrueValue cenv.g tycon + cudHelpersAccess=reprAccess + cudHasHelpers=ComputeUnionHasHelpers cenv.g tcref + cudDebugProxies= generateDebugProxies + cudDebugDisplayAttributes= ilDebugDisplayAttributes + cudAlternatives= alternatives + cudWhere = None} let tdef = - { Name = ilTypeName; - Layout = ILTypeDefLayout.Auto; - Access = access; - GenericParams = ilGenParams; + { Name = ilTypeName + Layout = ILTypeDefLayout.Auto + Access = access + GenericParams = ilGenParams CustomAttrs = mkILCustomAttrs (ilCustomAttrs @ [mkCompilationMappingAttr cenv.g (int (if hiddenRepr then SourceConstructFlags.SumType ||| SourceConstructFlags.NonPublicRepresentation - else SourceConstructFlags.SumType)) ]); - InitSemantics=ILTypeInit.BeforeField; - IsSealed=true; - IsAbstract=false; - tdKind= ILTypeDefKind.Class - Fields = ilFields; - Events= ilEvents; - Properties = ilProperties; - Methods= mkILMethods ilMethods; - MethodImpls= mkILMethodImpls methodImpls; - IsComInterop=false; - IsSerializable= isSerializable; - IsSpecialName= false; - NestedTypes=emptyILTypeDefs; - Encoding= ILDefaultPInvokeEncoding.Auto; - Implements= mkILTypes ilIntfTys; - Extends= Some cenv.g.ilg.typ_Object; - SecurityDecls= emptyILSecurityDecls; + else SourceConstructFlags.SumType)) ]) + InitSemantics=ILTypeInit.BeforeField + IsSealed=true + IsAbstract=false + tdKind= (if tycon.IsStructOrEnumTycon then ILTypeDefKind.ValueType else ILTypeDefKind.Class) + Fields = ilFields + Events= ilEvents + Properties = ilProperties + Methods= mkILMethods ilMethods + MethodImpls= mkILMethodImpls methodImpls + IsComInterop=false + IsSerializable= isSerializable + IsSpecialName= false + NestedTypes=emptyILTypeDefs + Encoding= ILDefaultPInvokeEncoding.Auto + Implements= mkILTypes ilIntfTys + Extends= Some (if tycon.IsStructOrEnumTycon then cenv.g.ilg.typ_ValueType else cenv.g.ilg.typ_Object) + SecurityDecls= emptyILSecurityDecls HasSecurity=false } let tdef2 = EraseUnions.mkClassUnionDef cenv.g.ilg tref tdef cuinfo @@ -6548,7 +6572,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | _ -> failwith "??" let tdef = {tdef with SecurityDecls= secDecls; HasSecurity=securityAttrs.Length > 0} - mgbuf.AddTypeDef(tref, tdef, false, false, tdefDiscards); + mgbuf.AddTypeDef(tref, tdef, false, false, tdefDiscards) // If a non-generic type is written with "static let" and "static do" (i.e. it has a ".cctor") // then the code for the .cctor is placed into .cctor for the backing static class for the file. @@ -6583,16 +6607,16 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = let ilMethodDef = mkLdfldMethodDef (ilMethName,reprAccess,false,ilThisTy,ilFieldName,ilPropType) let ilFieldDef = IL.mkILInstanceField(ilFieldName,ilPropType, None, ILMemberAccess.Assembly) let ilPropDef = - { Name=ilPropName; - IsRTSpecialName=false; - IsSpecialName=false; - SetMethod=None; - GetMethod=Some(mkILMethRef(tref,ILCallingConv.Instance,ilMethName,0,[],ilPropType)); - CallingConv=ILThisConvention.Instance; - Type=ilPropType; - Init=None; - Args=mkILTypes []; - CustomAttrs=mkILCustomAttrs (GenAttrs cenv eenv fld.PropertyAttribs @ [mkCompilationMappingAttrWithSeqNum cenv.g (int SourceConstructFlags.Field) i]); } + { Name=ilPropName + IsRTSpecialName=false + IsSpecialName=false + SetMethod=None + GetMethod=Some(mkILMethRef(tref,ILCallingConv.Instance,ilMethName,0,[],ilPropType)) + CallingConv=ILThisConvention.Instance + Type=ilPropType + Init=None + Args=mkILTypes [] + CustomAttrs=mkILCustomAttrs (GenAttrs cenv eenv fld.PropertyAttribs @ [mkCompilationMappingAttrWithSeqNum cenv.g (int SourceConstructFlags.Field) i]) } yield (ilMethodDef,ilFieldDef,ilPropDef,(ilPropName,ilFieldName,ilPropType)) ] |> List.unzip4 @@ -6619,9 +6643,9 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = mkMethodBody (false,emptyILLocals,8, nonBranchingInstrsToCode - [ mkLdarg0; - mkLdarg 1us; - mkLdarg 2us; + [ mkLdarg0 + mkLdarg 1us + mkLdarg 2us mkNormalCall (mkILCtorMethSpecForTy (cenv.g.ilg.typ_Exception,[serializationInfoType; cenv.g.ilg.typ_StreamingContext])) ] ,None)) @@ -6637,9 +6661,9 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = mkILReturn ILType.Void, (let code = nonBranchingInstrsToCode - [ mkLdarg0; - mkLdarg 1us; - mkLdarg 2us; + [ mkLdarg0 + mkLdarg 1us + mkLdarg 2us mkNormalCall (mkILNonGenericInstanceMethSpecInTy (cenv.g.ilg.typ_Exception, "GetObjectData", [serializationInfoType; cenv.g.ilg.typ_StreamingContext], ILType.Void)) ] mkMethodBody(true,emptyILLocals,8,code,None))) @@ -6649,7 +6673,7 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = | None -> ilMethodDef | Some securityPermissionAttributeType -> { ilMethodDef with - SecurityDecls=mkILSecurityDecls [ IL.mkPermissionSet cenv.g.ilg (ILSecurityAction.Demand,[(securityPermissionAttributeType, [("SerializationFormatter",cenv.g.ilg.typ_Bool, ILAttribElem.Bool(true))])])]; + SecurityDecls=mkILSecurityDecls [ IL.mkPermissionSet cenv.g.ilg (ILSecurityAction.Demand,[(securityPermissionAttributeType, [("SerializationFormatter",cenv.g.ilg.typ_Bool, ILAttribElem.Bool(true))])])] HasSecurity=true } [ilCtorDefForSerialziation; getObjectDataMethodForSerialization] #endif @@ -6688,21 +6712,21 @@ let CodegenAssembly cenv eenv mgbuf fileImpls = let GetEmptyIlxGenEnv (ilg : ILGlobals) ccu = let thisCompLoc = CompLocForCcu ccu - { tyenv=TypeReprEnv.Empty; - cloc = thisCompLoc; - valsInScope=ValMap<_>.Empty; - someTypeInThisAssembly=ilg.typ_Object; (* dummy value *) - isFinalFile = false; - letBoundVars=[]; - liveLocals=IntMap.empty(); - innerVals = []; - sigToImplRemapInfo = []; (* "module remap info" *) + { tyenv=TypeReprEnv.Empty + cloc = thisCompLoc + valsInScope=ValMap<_>.Empty + someTypeInThisAssembly=ilg.typ_Object (* dummy value *) + isFinalFile = false + letBoundVars=[] + liveLocals=IntMap.empty() + innerVals = [] + sigToImplRemapInfo = [] (* "module remap info" *) withinSEH = false } type IlxGenResults = - { ilTypeDefs: ILTypeDef list; - ilAssemAttrs : ILAttribute list; - ilNetModuleAttrs: ILAttribute list; + { ilTypeDefs: ILTypeDef list + ilAssemAttrs : ILAttribute list + ilNetModuleAttrs: ILAttribute list quotationResourceInfo: (ILTypeRef list * byte[]) list } @@ -6715,10 +6739,10 @@ let GenerateCode (cenv, eenv, TAssembly fileImpls, assemAttribs, moduleAttribs) let eenv = { eenv with cloc = CompLocForFragment cenv.opts.fragName cenv.viewCcu } // Generate the PrivateImplementationDetails type - GenTypeDefForCompLoc (cenv, eenv, mgbuf, CompLocForPrivateImplementationDetails eenv.cloc, useHiddenInitCode, [], ILTypeInit.BeforeField, true, (* atEnd= *) true); + GenTypeDefForCompLoc (cenv, eenv, mgbuf, CompLocForPrivateImplementationDetails eenv.cloc, useHiddenInitCode, [], ILTypeInit.BeforeField, true, (* atEnd= *) true) // Generate the whole assembly - CodegenAssembly cenv eenv mgbuf fileImpls; + CodegenAssembly cenv eenv mgbuf fileImpls let ilAssemAttrs = GenAttrs cenv eenv assemAttribs @@ -6749,7 +6773,7 @@ let GenerateCode (cenv, eenv, TAssembly fileImpls, assemAttribs, moduleAttribs) let referencedTypeDefs, freeTypes, spliceArgExprs = qscope.Close() for (_freeType, m) in freeTypes do - error(InternalError("A free type variable was detected in a reflected definition",m)); + error(InternalError("A free type variable was detected in a reflected definition",m)) for (_spliceArgExpr, m) in spliceArgExprs do error(Error(FSComp.SR.ilReflectedDefinitionsCannotUseSliceOperator(),m)) @@ -6777,9 +6801,9 @@ open System.Reflection /// The lookup* functions are the conversions available from ilreflect. type ExecutionContext = - { LookupFieldRef : (ILFieldRef -> FieldInfo); + { LookupFieldRef : (ILFieldRef -> FieldInfo) LookupMethodRef : (ILMethodRef -> MethodInfo) - LookupTypeRef : (ILTypeRef -> Type); + LookupTypeRef : (ILTypeRef -> Type) LookupType : (ILType -> Type) } // A helper to generate a default value for any System.Type. I couldn't find a System.Reflection @@ -6913,7 +6937,7 @@ type IlxAssemblyGenerator(amap: Import.ImportMap, tcGlobals: TcGlobals, tcVal : { g=tcGlobals TcVal = tcVal viewCcu = ccu - ilUnitTy = None; + ilUnitTy = None amap = amap casApplied = casApplied intraAssemblyInfo = intraAssemblyInfo diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index 5bbc36c6e1b..21556822240 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -237,7 +237,7 @@ module Pass1_DetermineTLRAndArities = (* REPORT OVER *) let arityM = Zmap.ofList valOrder fArities #if DEBUG - if verboseTLR then DumpArity arityM; + if verboseTLR then DumpArity arityM #endif tlrS,topValS, arityM @@ -342,20 +342,20 @@ let reqdItemOrder = /// The reqdTypars are the free reqdTypars of the defns, and those required by any direct TLR arity-met calls. /// The reqdItems are the ids/subEnvs required from calls to freeVars. type ReqdItemsForDefn = - { reqdTypars : Zset; - reqdItems : Zset; - m : Range.range; } + { reqdTypars : Zset + reqdItems : Zset + m : Range.range } member env.ReqdSubEnvs = [ for x in env.reqdItems do match x with | ReqdSubEnv f -> yield f | ReqdVal _ -> () ] member env.ReqdVals = [ for x in env.reqdItems do match x with | ReqdSubEnv _ -> () | ReqdVal v -> yield v ] member env.Extend (typars,items) = {env with - reqdTypars = Zset.addList typars env.reqdTypars; + reqdTypars = Zset.addList typars env.reqdTypars reqdItems = Zset.addList items env.reqdItems} static member Initial typars m = - {reqdTypars = Zset.addList typars (Zset.empty typarOrder); - reqdItems = Zset.empty reqdItemOrder; + {reqdTypars = Zset.addList typars (Zset.empty typarOrder) + reqdItems = Zset.empty reqdItemOrder m = m } override env.ToString() = @@ -427,19 +427,19 @@ module Pass2_DetermineReqdItems = /// /// recShortCalls to f will require a binding for f in terms of fHat within the fHatBody. type state = - { stack : (BindingGroupSharingSameReqdItems * Generators * ReqdItemsForDefn) list; - reqdItemsMap : Zmap; - fclassM : Zmap; - revDeclist : BindingGroupSharingSameReqdItems list; - recShortCallS : Zset; + { stack : (BindingGroupSharingSameReqdItems * Generators * ReqdItemsForDefn) list + reqdItemsMap : Zmap + fclassM : Zmap + revDeclist : BindingGroupSharingSameReqdItems list + recShortCallS : Zset } let state0 = - { stack = []; - reqdItemsMap = Zmap.empty fclassOrder; - fclassM = Zmap.empty valOrder; - revDeclist = []; - recShortCallS = Zset.empty valOrder; } + { stack = [] + reqdItemsMap = Zmap.empty fclassOrder + fclassM = Zmap.empty valOrder + revDeclist = [] + recShortCallS = Zset.empty valOrder } /// PUSH = start collecting for fclass let PushFrame (fclass: BindingGroupSharingSameReqdItems) (reqdTypars0,reqdVals0,m) state = @@ -447,12 +447,12 @@ module Pass2_DetermineReqdItems = state else {state with - revDeclist = fclass :: state.revDeclist; - stack = (let env = ReqdItemsForDefn.Initial reqdTypars0 m in (fclass,reqdVals0,env)::state.stack); } + revDeclist = fclass :: state.revDeclist + stack = (let env = ReqdItemsForDefn.Initial reqdTypars0 m in (fclass,reqdVals0,env)::state.stack) } /// POP & SAVE = end collecting for fclass and store let SaveFrame (fclass: BindingGroupSharingSameReqdItems) state = - if verboseTLR then dprintf "SaveFrame: %A\n" fclass; + if verboseTLR then dprintf "SaveFrame: %A\n" fclass if fclass.IsEmpty then state else @@ -460,8 +460,8 @@ module Pass2_DetermineReqdItems = | [] -> internalError "trl: popFrame has empty stack" | (fclass,_reqdVals0,env)::stack -> (* ASSERT: same fclass *) {state with - stack = stack; - reqdItemsMap = Zmap.add fclass env state.reqdItemsMap; + stack = stack + reqdItemsMap = Zmap.add fclass env state.reqdItemsMap fclassM = FlatList.fold (fun mp (k,v) -> Zmap.add k v mp) state.fclassM fclass.Pairs } /// Log requirements for gv in the relevant stack frames @@ -478,12 +478,12 @@ module Pass2_DetermineReqdItems = let LogShortCall gv state = if state.stack |> List.exists (fun (fclass,_reqdVals0,_env) -> fclass.Contains gv) then - if verboseTLR then dprintf "shortCall: rec: %s\n" gv.LogicalName; + if verboseTLR then dprintf "shortCall: rec: %s\n" gv.LogicalName // Have short call to gv within it's (mutual) definition(s) {state with recShortCallS = Zset.add gv state.recShortCallS} else - if verboseTLR then dprintf "shortCall: not-rec: %s\n" gv.LogicalName; + if verboseTLR then dprintf "shortCall: not-rec: %s\n" gv.LogicalName state let FreeInBindings bs = FlatList.fold (foldOn (freeInBindingRhs CollectTyparsAndLocals) unionFreeVars) emptyFreeVars bs @@ -569,7 +569,7 @@ module Pass2_DetermineReqdItems = /// For each direct call to a gv, a generator for fclass, /// Required to include the reqdTypars(gv) in reqdTypars(fclass). let CloseReqdTypars fclassM reqdItemsMap = - if verboseTLR then dprintf "CloseReqdTypars------\n"; + if verboseTLR then dprintf "CloseReqdTypars------\n" let closeStep reqdItemsMap changed fc (env: ReqdItemsForDefn) = let directCallReqdEnvs = env.ReqdSubEnvs @@ -584,7 +584,7 @@ module Pass2_DetermineReqdItems = let env = {env with reqdTypars = reqdTypars} #if DEBUG if verboseTLR then - dprintf "closeStep: fc=%30A nSubs=%d reqdTypars0=%s reqdTypars=%s\n" fc directCallReqdEnvs.Length (showTyparSet reqdTypars0) (showTyparSet reqdTypars); + dprintf "closeStep: fc=%30A nSubs=%d reqdTypars0=%s reqdTypars=%s\n" fc directCallReqdEnvs.Length (showTyparSet reqdTypars0) (showTyparSet reqdTypars) directCallReqdEnvs |> List.iter (fun f -> dprintf "closeStep: dcall f=%s\n" f.LogicalName) directCallReqdEnvs |> List.iter (fun f -> dprintf "closeStep: dcall fc=%A\n" (Zmap.find f fclassM)) directCallReqdTypars |> List.iter (fun _reqdTypars -> dprintf "closeStep: dcall reqdTypars=%s\n" (showTyparSet reqdTypars0)) @@ -610,7 +610,7 @@ module Pass2_DetermineReqdItems = #endif let DetermineReqdItems (tlrS,arityM) expr = - if verboseTLR then dprintf "DetermineReqdItems------\n"; + if verboseTLR then dprintf "DetermineReqdItems------\n" let folder = {ExprFolder0 with exprIntercept = ExprEnvIntercept (tlrS,arityM)} let z = state0 // Walk the entire assembly @@ -622,7 +622,7 @@ module Pass2_DetermineReqdItems = let recShortCallS = z.recShortCallS // diagnostic dump #if DEBUG - if verboseTLR then DumpReqdValMap reqdItemsMap; + if verboseTLR then DumpReqdValMap reqdItemsMap #endif // close the reqdTypars under the subEnv reln let reqdItemsMap = CloseReqdTypars fclassM reqdItemsMap @@ -633,7 +633,7 @@ module Pass2_DetermineReqdItems = #if DEBUG // diagnostic dump if verboseTLR then - DumpReqdValMap reqdItemsMap; + DumpReqdValMap reqdItemsMap declist |> List.iter (fun fc -> dprintf "Declist: %A\n" fc) recShortCallS |> Zset.iter (fun f -> dprintf "RecShortCall: %s\n" f.LogicalName) #endif @@ -659,13 +659,13 @@ module Pass2_DetermineReqdItems = type PackedReqdItems = { /// The actual typars - ep_etps : Typars; + ep_etps : Typars /// The actual env carrier values - ep_aenvs : Val list; + ep_aenvs : Val list /// Sequentially define the aenvs in terms of the fvs - ep_pack : Bindings; + ep_pack : Bindings /// Sequentially define the fvs in terms of the aenvs - ep_unpack : Bindings; + ep_unpack : Bindings } @@ -696,7 +696,7 @@ exception AbortTLR of Range.range let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap) = let fclassOf f = Zmap.force f fclassM ("fclassM",nameOfVal) let packEnv carrierMaps (fc:BindingGroupSharingSameReqdItems) = - if verboseTLR then dprintf "\ntlr: packEnv fc=%A\n" fc; + if verboseTLR then dprintf "\ntlr: packEnv fc=%A\n" fc let env = Zmap.force fc reqdItemsMap ("packEnv",string) // carrierMaps = (fclass,(v,aenv)map)map @@ -722,10 +722,10 @@ let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap FlatList.tryFind (IsGenericValWithGenericContraints g) with | None -> () - | Some v -> raise (AbortTLR v.Range); + | Some v -> raise (AbortTLR v.Range) // build cmap for env let cmapPairs = vals |> FlatList.map (fun v -> (v,(mkCompGenLocal env.m v.LogicalName v.Type |> fst))) @@ -774,17 +774,17 @@ let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap showL (valL v))) let fc = Zmap.force f fclassM ("createFHat - fc",nameOfVal) @@ -866,16 +866,16 @@ let CreateNewValuesForTLR g tlrS arityM fclassM envPackM = module Pass4_RewriteAssembly = [] type RewriteContext = - { ccu : CcuThunk; - g : TcGlobals; - tlrS : Zset ; - topValS : Zset ; - arityM : Zmap ; - fclassM : Zmap ; - recShortCallS : Zset ; - envPackM : Zmap; + { ccu : CcuThunk + g : TcGlobals + tlrS : Zset + topValS : Zset + arityM : Zmap + fclassM : Zmap + recShortCallS : Zset + envPackM : Zmap /// The mapping from 'f' values to 'fHat' values - fHatM : Zmap ; + fHatM : Zmap } @@ -898,9 +898,9 @@ module Pass4_RewriteAssembly = /// Any TLR repr bindings under lambdas can be filtered out (and collected), /// giving pre-declarations to insert before the outermost lambda expr. type RewriteState = - { rws_mustinline: bool; + { rws_mustinline: bool /// counts level of enclosing "lambdas" - rws_innerLevel : int; + rws_innerLevel : int /// collected preDecs (fringe is in-order) rws_preDecs : Tree } @@ -1345,7 +1345,7 @@ let MakeTLRDecisions ccu g expr = let fHatM = CreateNewValuesForTLR g tlrS arityM fclassM envPackM // pass4: rewrite - if verboseTLR then dprintf "TransExpr(rw)------\n"; + if verboseTLR then dprintf "TransExpr(rw)------\n" let expr,_ = let penv : Pass4_RewriteAssembly.RewriteContext = {ccu=ccu; g=g; tlrS=tlrS; topValS=topValS; arityM=arityM; fclassM=fclassM; recShortCallS=recShortCallS; envPackM=envPackM; fHatM=fHatM} @@ -1354,9 +1354,9 @@ let MakeTLRDecisions ccu g expr = // pass5: copyExpr to restore "each bound is unique" property // aka, copyExpr - if verboseTLR then dprintf "copyExpr------\n"; + if verboseTLR then dprintf "copyExpr------\n" let expr = RecreateUniqueBounds g expr - if verboseTLR then dprintf "TLR-done------\n"; + if verboseTLR then dprintf "TLR-done------\n" // Summary: // GTL = genuine top-level @@ -1370,5 +1370,5 @@ let MakeTLRDecisions ccu g expr = // DONE expr with AbortTLR m -> - warning(Error(FSComp.SR.tlrLambdaLiftingOptimizationsNotApplied(),m)); + warning(Error(FSComp.SR.tlrLambdaLiftingOptimizationsNotApplied(),m)) expr diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index e4ef817ca77..5ef87ac8f58 100755 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -534,7 +534,6 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, new LexbufState(lexbuf.StartPos, lexbuf.EndPos, lexbuf.IsPastEndOfStream) let setLexbufState (p:LexbufState) = - // if debug then dprintf "SET lex state to; %a\n" output_any p; lexbuf.StartPos <- p.StartPos lexbuf.EndPos <- p.EndPos lexbuf.IsPastEndOfStream <- p.PastEOF @@ -927,6 +926,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | MINUS | GLOBAL | CONST + | KEYWORD_STRING _ | NULL | INT8 _ | INT16 _ | INT32 _ | INT64 _ | NATIVEINT _ | UINT8 _ | UINT16 _ | UINT32 _ | UINT64 _ | UNATIVEINT _ diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerCallsAndSeqs.fs index 571997f761f..34289568ad8 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -58,9 +58,9 @@ let InterceptExpr g cont expr = /// any known arguments. The results are later optimized by the peephole /// optimizer in opt.fs let LowerImplFile g ass = - RewriteImplFile { PreIntercept = Some(InterceptExpr g); + RewriteImplFile { PreIntercept = Some(InterceptExpr g) PreInterceptBinding=None - PostTransform= (fun _ -> None); + PostTransform= (fun _ -> None) IsUnderQuotations=false } ass @@ -76,7 +76,7 @@ let mkUnitDelayLambda g m e = let callNonOverloadedMethod g amap m methName ty args = match TryFindIntrinsicMethInfo (InfoReader(g,amap)) m AccessibleFromSomeFSharpCode methName ty with - | [] -> error(InternalError("No method called '"+methName+"' was found",m)); + | [] -> error(InternalError("No method called '"+methName+"' was found",m)) | ILMeth(g,ilMethInfo,_) :: _ -> // REVIEW: consider if this should ever be a constrained call. At the moment typecheck limitations in the F# typechecker // ensure the enumerator type used within computation expressions is not a struct type @@ -189,9 +189,9 @@ let LowerSeqExpr g amap overallExpr = match expr with | SeqYield(e,m) -> // printfn "found Seq.singleton" - //this.pc <- NEXT; - //curr <- e; - //return true; + //this.pc <- NEXT + //curr <- e + //return true //NEXT: let label = IL.generateCodeLabel() Some { phase2 = (fun (pcv,currv,_nextv,pcMap) -> @@ -211,9 +211,9 @@ let LowerSeqExpr g amap overallExpr = mkCompGenSequential m (Expr.Op(TOp.Label label,[],[],m)) (Expr.Op(TOp.Return,[],[mkBool g m (not (noDisposeContinuationLabel = currentDisposeContinuationLabel))],m)) - generate,dispose,checkDispose); - labels=[label]; - stateVars=[]; + generate,dispose,checkDispose) + labels=[label] + stateVars=[] significantClose = false } @@ -233,8 +233,8 @@ let LowerSeqExpr g amap overallExpr = // However leaving as is for now. let dispose = mkCompGenSequential m dispose2 dispose1 let checkDispose = mkCompGenSequential m checkDispose2 checkDispose1 - generate,dispose,checkDispose); - labels= res1.labels @ res2.labels; + generate,dispose,checkDispose) + labels= res1.labels @ res2.labels stateVars = res1.stateVars @ res2.stateVars significantClose = res1.significantClose || res2.significantClose } | _ -> @@ -248,8 +248,8 @@ let LowerSeqExpr g amap overallExpr = let generate = mkWhile g (SequencePointAtWhileLoop e1.Range,NoSpecialWhileLoopMarker,e1,generate2,m) let dispose = dispose2 let checkDispose = checkDispose2 - generate,dispose,checkDispose); - labels = res2.labels; + generate,dispose,checkDispose) + labels = res2.labels stateVars = res2.stateVars significantClose = res2.significantClose } | _ -> @@ -312,8 +312,8 @@ let LowerSeqExpr g amap overallExpr = (Expr.Op(TOp.Label innerDisposeContinuationLabel,[],[],m)) (Expr.Op(TOp.Return,[],[mkTrue g m (* yes, we must dispose!!! *) ],m))) - generate,dispose,checkDispose); - labels = innerDisposeContinuationLabel :: res1.labels; + generate,dispose,checkDispose) + labels = innerDisposeContinuationLabel :: res1.labels stateVars = res1.stateVars significantClose = true } | _ -> @@ -324,7 +324,7 @@ let LowerSeqExpr g amap overallExpr = let generate = mkUnit g m let dispose = Expr.Op(TOp.Goto currentDisposeContinuationLabel,[],[],m) let checkDispose = Expr.Op(TOp.Goto currentDisposeContinuationLabel,[],[],m) - generate,dispose,checkDispose); + generate,dispose,checkDispose) labels = [] stateVars = [] significantClose = false } @@ -376,7 +376,7 @@ let LowerSeqExpr g amap overallExpr = (mkValSet m vref (mkDefault (m,vref.Type))) let dispose = dispose2 let checkDispose = checkDispose2 - generate,dispose,checkDispose); + generate,dispose,checkDispose) stateVars = vref::res2.stateVars } | None -> None @@ -402,8 +402,8 @@ let LowerSeqExpr g amap overallExpr = let generate = primMkMatch (spBind,exprm,pt,Array.ofList gtgs,m,ty) let dispose = if isNil disposals then mkUnit g m else List.reduce (mkCompGenSequential m) disposals let checkDispose = if isNil checkDisposes then mkFalse g m else List.reduce (mkCompGenSequential m) checkDisposes - generate,dispose,checkDispose); - labels=labs; + generate,dispose,checkDispose) + labels=labs stateVars = stateVars significantClose = significantClose } else @@ -418,7 +418,7 @@ let LowerSeqExpr g amap overallExpr = // This can give rise to infinite iterator chains when implemented by the naive expansion to // “for x in e yield e”. For example consider this: // - // let rec rwalk x = { yield x; + // let rec rwalk x = { yield x // yield! rwalk (x + rand()) } // // This is the moral equivalent of a tailcall optimization. These also don’t compile well @@ -439,9 +439,9 @@ let LowerSeqExpr g amap overallExpr = // printfn "found yield!" let inpElemTy = List.head (argsOfAppTy g ty) if isTailCall then - //this.pc <- NEXT; - //nextEnumerator <- e; - //return 2; + //this.pc <- NEXT + //nextEnumerator <- e + //return 2 //NEXT: let label = IL.generateCodeLabel() Some { phase2 = (fun (pcv,_currv,nextv,pcMap) -> @@ -461,7 +461,7 @@ let LowerSeqExpr g amap overallExpr = mkCompGenSequential m (Expr.Op(TOp.Label label,[],[],m)) (Expr.Op(TOp.Return,[],[mkFalse g m],m)) - generate,dispose,checkDispose); + generate,dispose,checkDispose) labels=[label] stateVars=[] significantClose = false } diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 43731c50ae2..14c41717483 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -62,15 +62,17 @@ type CalledArg = { Position: (int * int) IsParamArray : bool OptArgInfo : OptionalArgInfo + CallerInfoInfo : CallerInfoInfo IsOutArg: bool ReflArgInfo: ReflectedArgInfo NameOpt: Ident option CalledArgumentType : TType } -let CalledArg(pos,isParamArray,optArgInfo,isOutArg,nameOpt,reflArgInfo,calledArgTy) = +let CalledArg(pos,isParamArray,optArgInfo,callerInfoInfo,isOutArg,nameOpt,reflArgInfo,calledArgTy) = { Position=pos IsParamArray=isParamArray OptArgInfo =optArgInfo + CallerInfoInfo = callerInfoInfo IsOutArg=isOutArg ReflArgInfo=reflArgInfo NameOpt=nameOpt @@ -198,10 +200,11 @@ type CalledMethArgSet<'T> = let MakeCalledArgs amap m (minfo:MethInfo) minst = // Mark up the arguments with their position, so we can sort them back into order later let paramDatas = minfo.GetParamDatas(amap, m, minst) - paramDatas |> List.mapiSquared (fun i j (ParamData(isParamArrayArg,isOutArg,optArgInfo,nmOpt,reflArgInfo,typeOfCalledArg)) -> + paramDatas |> List.mapiSquared (fun i j (ParamData(isParamArrayArg,isOutArg,optArgInfo,callerInfoFlags,nmOpt,reflArgInfo,typeOfCalledArg)) -> { Position=(i,j) IsParamArray=isParamArrayArg OptArgInfo=optArgInfo + CallerInfoInfo = callerInfoFlags IsOutArg=isOutArg ReflArgInfo=reflArgInfo NameOpt=nmOpt diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 9ebd2bafafe..74cedde7377 100755 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -483,8 +483,8 @@ let AddFakeNameToNameEnv nm nenv item = /// Add a set of F# values to the environment. let AddValRefsToNameEnvWithPriority bulkAddMode pri nenv vrefs = - {nenv with eUnqualifiedItems= AddValRefsToItems bulkAddMode nenv.eUnqualifiedItems vrefs; - eIndexedExtensionMembers = (nenv.eIndexedExtensionMembers,vrefs) ||> Array.fold (AddValRefToExtensionMembers pri); + {nenv with eUnqualifiedItems= AddValRefsToItems bulkAddMode nenv.eUnqualifiedItems vrefs + eIndexedExtensionMembers = (nenv.eIndexedExtensionMembers,vrefs) ||> Array.fold (AddValRefToExtensionMembers pri) ePatItems = (nenv.ePatItems,vrefs) ||> Array.fold (fun acc vref -> let ePatItems = @@ -507,7 +507,7 @@ let AddValRefToNameEnv nenv vref = let AddActivePatternResultTagsToNameEnv (apinfo: PrettyNaming.ActivePatternInfo) nenv ty m = let nms = apinfo.Names let apresl = nms |> List.mapi (fun j nm -> nm, j) - { nenv with eUnqualifiedItems= (apresl,nenv.eUnqualifiedItems) ||> List.foldBack (fun (nm,j) acc -> acc.Add(nm, Item.ActivePatternResult(apinfo,ty,j, m))); } + { nenv with eUnqualifiedItems= (apresl,nenv.eUnqualifiedItems) ||> List.foldBack (fun (nm,j) acc -> acc.Add(nm, Item.ActivePatternResult(apinfo,ty,j, m))) } /// Generalize a union case, from Cons --> List.Cons let GeneralizeUnionCaseRef (ucref:UnionCaseRef) = @@ -627,11 +627,11 @@ let AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap m root nenv tcrefs = let tcrefs = Array.ofList tcrefs { env with eFullyQualifiedTyconsByDemangledNameAndArity= - (if root then AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eFullyQualifiedTyconsByDemangledNameAndArity else nenv.eFullyQualifiedTyconsByDemangledNameAndArity); + (if root then AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eFullyQualifiedTyconsByDemangledNameAndArity else nenv.eFullyQualifiedTyconsByDemangledNameAndArity) eFullyQualifiedTyconsByAccessNames= - (if root then AddTyconByAccessNames bulkAddMode tcrefs nenv.eFullyQualifiedTyconsByAccessNames else nenv.eFullyQualifiedTyconsByAccessNames); + (if root then AddTyconByAccessNames bulkAddMode tcrefs nenv.eFullyQualifiedTyconsByAccessNames else nenv.eFullyQualifiedTyconsByAccessNames) eTyconsByDemangledNameAndArity= - AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eTyconsByDemangledNameAndArity; + AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eTyconsByDemangledNameAndArity eTyconsByAccessNames= AddTyconByAccessNames bulkAddMode tcrefs nenv.eTyconsByAccessNames } @@ -679,7 +679,7 @@ let rec AddModuleOrNamespaceRefsToNameEnv g amap m root ad nenv (modrefs: Module NameMap.layerAdditive add modrefsMap tab let nenv = {nenv with - eModulesAndNamespaces= addModrefs nenv.eModulesAndNamespaces; + eModulesAndNamespaces= addModrefs nenv.eModulesAndNamespaces eFullyQualifiedModulesAndNamespaces = (if root then addModrefs nenv.eFullyQualifiedModulesAndNamespaces @@ -754,7 +754,7 @@ let AddDeclaredTyparsToNameEnv check nenv typars = if Map.containsKey tp.Name sofar then errorR (Duplicate("type parameter",tp.DisplayName,tp.Range)) | NoCheckForDuplicateTypars -> () - end; + end Map.add tp.Name tp sofar) typars Map.empty {nenv with eTypars=NameMap.layer typarmap nenv.eTypars } @@ -1507,8 +1507,8 @@ type ResolutionInfo = static member SendToSink(sink, ncenv: NameResolver, nenv, occ, ad, ResolutionInfo(entityPath,warnings), typarChecker) = entityPath |> List.iter (fun (m,eref:EntityRef) -> - CheckEntityAttributes ncenv.g eref m |> CommitOperationResult; - CheckTyconAccessible ncenv.amap m ad eref |> ignore; + CheckEntityAttributes ncenv.g eref m |> CommitOperationResult + CheckTyconAccessible ncenv.amap m ad eref |> ignore let item = if eref.IsModuleOrNamespace then Item.ModuleOrNamespaces [eref] @@ -1656,7 +1656,7 @@ let private ResolveObjectConstructorPrim (ncenv:NameResolver) edenv resInfo m ad success (resInfo, Item.FakeInterfaceCtor typ) else let defaultStructCtorInfo = - if (isStructTy g typ && not(isRecdTy g typ) && not(ctorInfos |> List.exists (fun x -> x.IsNullary))) then + if (isStructTy g typ && not (isRecdTy g typ) && not (isUnionTy g typ) && not(ctorInfos |> List.exists (fun x -> x.IsNullary))) then [DefaultStructCtor(g,typ)] else [] if (isNil defaultStructCtorInfo && isNil ctorInfos) || not (isAppTy g typ) then @@ -1923,7 +1923,7 @@ let ResolveLongIdentInType sink ncenv nenv lookupKind m ad lid findFlag typeName ResolveLongIdentInTypePrim (ncenv:NameResolver) nenv lookupKind ResolutionInfo.Empty 0 m ad lid findFlag typeNameResInfo typ |> AtMostOneResult m |> ForceRaise - ResolutionInfo.SendToSink (sink,ncenv,nenv,ItemOccurence.UseInType,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)); + ResolutionInfo.SendToSink (sink,ncenv,nenv,ItemOccurence.UseInType,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) item,rest let private ResolveLongIdentInTyconRef (ncenv:NameResolver) nenv lookupKind resInfo depth m ad lid typeNameResInfo tcref = @@ -2063,7 +2063,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) fullyQualified m ad n match AtMostOneResult m search with | Result _ as res -> let resInfo,item,rest = ForceRaise res - ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)); + ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) Some(item,rest) | _ -> None @@ -2088,7 +2088,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) fullyQualified m ad n let failingCase = raze (UndefinedName(0,FSComp.SR.undefinedNameValueOfConstructor,id,NoPredictions)) let search = ctorSearch +++ implicitOpSearch +++ failingCase let resInfo,item,rest = ForceRaise (AtMostOneResult m search) - ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)); + ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) item,rest @@ -2144,7 +2144,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) fullyQualified m ad n | _ -> let failingCase = raze (UndefinedName(0,FSComp.SR.undefinedNameValueNamespaceTypeOrModule,id,NoPredictions)) ForceRaise (AtMostOneResult m (search +++ moduleSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode +++ failingCase)) - ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)); + ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) item,rest let ResolveExprLongIdent sink (ncenv:NameResolver) m ad nenv typeNameResInfo lid = @@ -2241,7 +2241,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv:NameResolver) fullyQualified war (warnOnUpper = WarnOnUpperCase) && id.idText.Length >= 3 && System.Char.ToLowerInvariant id.idText.[0] <> id.idText.[0] then - warning(UpperCaseIdentifierInPattern(m)); + warning(UpperCaseIdentifierInPattern(m)) Item.NewDef id // Long identifiers in patterns @@ -2262,9 +2262,9 @@ let rec ResolvePatternLongIdentPrim sink (ncenv:NameResolver) fullyQualified war | Result _ as res -> ForceRaise res | _ -> ForceRaise (AtMostOneResult m (tyconSearch AccessibleFromSomeFSharpCode +++ moduleSearch AccessibleFromSomeFSharpCode)) - ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> true)); + ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> true)) - if nonNil rest then error(Error(FSComp.SR.nrIsNotConstructorOrLiteral(),(List.head rest).idRange)); + if nonNil rest then error(Error(FSComp.SR.nrIsNotConstructorOrLiteral(),(List.head rest).idRange)) res @@ -2326,7 +2326,7 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv:NameResolver) (typeNameResInfo /// Resolve a long identifier representing a type name and report the result let ResolveTypeLongIdentInTyconRef sink (ncenv:NameResolver) nenv typeNameResInfo ad m tcref (lid: Ident list) = let resInfo,tcref = ForceRaise (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad ResolutionInfo.Empty PermitDirectReferenceToGeneratedType.No 0 m tcref lid) - ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> true)); + ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> true)) let item = Item.Types(tcref.DisplayName,[FreshenTycon ncenv m tcref]) CallNameResolutionSink sink (rangeOfLid lid,nenv,item,item,ItemOccurence.UseInType,nenv.eDisplayEnv,ad) tcref @@ -2391,7 +2391,7 @@ let rec ResolveTypeLongIdentPrim (ncenv:NameResolver) fullyQualified m nenv ad ( match tcrefs with | tcref :: _tcrefs -> // Note: This path is only for error reporting - //CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities tcref rest typeNameResInfo m; + //CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities tcref rest typeNameResInfo m success(ResolutionInfo.Empty,tcref) | [] -> raze (UndefinedName(0,FSComp.SR.undefinedNameType,id,NoPredictions)) @@ -2442,7 +2442,7 @@ let ResolveTypeLongIdent sink (ncenv:NameResolver) occurence fullyQualified nenv // Register the result as a name resolution match res with | Result (resInfo,tcref) -> - ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.UseInType, ad,resInfo,ResultTyparChecker(fun () -> true)); + ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.UseInType, ad,resInfo,ResultTyparChecker(fun () -> true)) let item = Item.Types(tcref.DisplayName,[FreshenTycon ncenv m tcref]) CallNameResolutionSink sink (m,nenv,item,item,occurence,nenv.eDisplayEnv,ad) | _ -> () @@ -2591,7 +2591,7 @@ let ResolveFieldPrim (ncenv:NameResolver) nenv ad typ (mp,id:Ident) allFields = ResolveLongIndentAsModuleOrNamespaceThen ncenv.amap m OpenQualified nenv ad lid (ResolveFieldInModuleOrNamespace ncenv nenv ad) let resInfo,item,rest = ForceRaise (AtMostOneResult m (modulSearch ad +++ tyconSearch ad +++ modulSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode)) - if nonNil rest then errorR(Error(FSComp.SR.nrInvalidFieldLabel(),(List.head rest).idRange)); + if nonNil rest then errorR(Error(FSComp.SR.nrInvalidFieldLabel(),(List.head rest).idRange)) [(resInfo,item)] let ResolveField sink ncenv nenv ad typ (mp,id) allFields = @@ -2599,7 +2599,7 @@ let ResolveField sink ncenv nenv ad typ (mp,id) allFields = // Register the results of any field paths "Module.Type" in "Module.Type.field" as a name resolution. (Note, the path resolution // info is only non-empty if there was a unique resolution of the field) for (resInfo,_rfref) in res do - ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.UseInType, ad,resInfo,ResultTyparChecker(fun () -> true)); + ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.UseInType, ad,resInfo,ResultTyparChecker(fun () -> true)) res |> List.map snd /// Generate a new reference to a record field with a fresh type instantiation @@ -2737,7 +2737,7 @@ let ResolveExprDotLongIdentAndComputeRange (sink:TcResultsSink) (ncenv:NameResol resInfo,item,rest,itemRange // "true" resolution let resInfo,item,rest,itemRange = resolveExpr findFlag - ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap itemRange item)); + ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap itemRange item)) // Record the precise resolution of the field for intellisense/goto definition let afterOverloadResolution = diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index 609134d68d3..e4dc8100c44 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -1193,7 +1193,7 @@ module InfoMemberPrinting = /// Format the arguments of a method to a buffer. /// /// This uses somewhat "old fashioned" printf-style buffer printing. - let formatParamDataToBuffer denv os (ParamData(isParamArray, _isOutArg, optArgInfo, nmOpt, _reflArgInfo, pty)) = + let formatParamDataToBuffer denv os (ParamData(isParamArray, _isOutArg, optArgInfo, _callerInfoInfo, nmOpt, _reflArgInfo, pty)) = let isOptArg = optArgInfo.IsOptional match isParamArray, nmOpt, isOptArg, tryDestOptionTy denv.g pty with // Layout an optional argument diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 186113ed2a2..7867a3569dc 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -101,7 +101,7 @@ type ExprValueInfo = | ConstExprValue of int * Expr type ValInfo = - { ValMakesNoCriticalTailcalls: bool; + { ValMakesNoCriticalTailcalls: bool ValExprInfo: ExprValueInfo } //------------------------------------------------------------------------- @@ -140,7 +140,7 @@ type ValInfos(entries) = member x.TryFindForFslib (v:ValRef) = valInfosForFslib.Force().TryFind(v.Deref.LinkagePartialKey) type ModuleInfo = - { ValInfos: ValInfos; + { ValInfos: ValInfos ModuleOrNamespaceInfos: NameMap } and LazyModuleInfo = Lazy @@ -174,11 +174,11 @@ and valInfoL g (x:ValInfo) = #endif type Summary<'Info> = - { Info: 'Info; + { Info: 'Info /// What's the contribution to the size of this function? - FunctionSize: int; + FunctionSize: int /// What's the total contribution to the size of the assembly, including closure classes etc.? - TotalSize: int; + TotalSize: int /// Meaning: could mutate, could non-terminate, could raise exception /// One use: an effect expr can not be eliminated as dead code (e.g. sequencing) /// One use: an effect=false expr can not throw an exception? so try-catch is removed. @@ -247,36 +247,36 @@ let [] localOptDefault = true let [] crossModuleOptDefault = true type OptimizationSettings = - { abstractBigTargets : bool; - jitOptUser : bool option; - localOptUser : bool option; - crossModuleOptUser : bool option; + { abstractBigTargets : bool + jitOptUser : bool option + localOptUser : bool option + crossModuleOptUser : bool option /// size after which we start chopping methods in two, though only at match targets bigTargetSize : int /// size after which we start enforcing splitting sub-expressions to new methods, to avoid hitting .NET IL limitations veryBigExprSize : int /// The size after which we don't inline - lambdaInlineThreshold : int; + lambdaInlineThreshold : int /// For unit testing reportingPhase : bool - reportNoNeedToTailcall: bool; + reportNoNeedToTailcall: bool reportFunctionSizes : bool reportHasEffect : bool reportTotalSizes : bool } static member Defaults = - { abstractBigTargets = false; - jitOptUser = None; + { abstractBigTargets = false + jitOptUser = None localOptUser = None /// size after which we start chopping methods in two, though only at match targets bigTargetSize = 100 /// size after which we start enforcing splitting sub-expressions to new methods, to avoid hitting .NET IL limitations veryBigExprSize = 3000 - crossModuleOptUser = None; + crossModuleOptUser = None /// The size after which we don't inline - lambdaInlineThreshold = 6; - reportingPhase = false; - reportNoNeedToTailcall = false; + lambdaInlineThreshold = 6 + reportingPhase = false + reportNoNeedToTailcall = false reportFunctionSizes = false reportHasEffect = false reportTotalSizes = false @@ -309,41 +309,41 @@ type OptimizationSettings = #else type cenv = - { g: TcGlobals; + { g: TcGlobals TcVal : ConstraintSolver.TcValF - amap: Import.ImportMap; - optimizing: bool; - scope: CcuThunk; + amap: Import.ImportMap + optimizing: bool + scope: CcuThunk localInternalVals: System.Collections.Generic.Dictionary - settings: OptimizationSettings; - emitTailcalls: bool; + settings: OptimizationSettings + emitTailcalls: bool // cache methods with SecurityAttribute applied to them, to prevent unnecessary calls to ExistsInEntireHierarchyOfType - casApplied : Dictionary;} + casApplied : Dictionary} type IncrementalOptimizationEnv = { // An identifier to help with name generation - latestBoundId: Ident option; + latestBoundId: Ident option // The set of lambda IDs we've inlined to reach this point. Helps to prevent recursive inlining - dontInline: Zset; + dontInline: Zset // Recursively bound vars. If an sub-expression that is a candidate for method splitting // contains any of these variables then don't split it, for fear of mucking up tailcalls. // See FSharp 1.0 bug 2892 - dontSplitVars: ValMap; + dontSplitVars: ValMap /// The Val for the function binding being generated, if any. - functionVal: (Val * Tast.ValReprInfo) option; - typarInfos: (Typar * TypeValueInfo) list; - localExternalVals: LayeredMap; - globalModuleInfos: LayeredMap; } + functionVal: (Val * Tast.ValReprInfo) option + typarInfos: (Typar * TypeValueInfo) list + localExternalVals: LayeredMap + globalModuleInfos: LayeredMap } static member Empty = - { latestBoundId = None; - dontInline = Zset.empty Int64.order; - typarInfos = []; - functionVal = None; - dontSplitVars = ValMap.Empty; - localExternalVals = LayeredMap.Empty; + { latestBoundId = None + dontInline = Zset.empty Int64.order + typarInfos = [] + functionVal = None + dontSplitVars = ValMap.Empty + localExternalVals = LayeredMap.Empty globalModuleInfos = LayeredMap.Empty } //------------------------------------------------------------------------- @@ -368,7 +368,7 @@ let CheckInlineValueIsComplete (v:Val) res = //System.Diagnostics.Debug.Assert(false,sprintf "Break for incomplete inline value %s" v.DisplayName) let check (vref: ValRef) (res:ValInfo) = - CheckInlineValueIsComplete vref.Deref res.ValExprInfo; + CheckInlineValueIsComplete vref.Deref res.ValExprInfo (vref,res) //------------------------------------------------------------------------- @@ -423,15 +423,14 @@ let BindInternalLocalVal cenv (v:Val) vval env = | UnknownValue -> env | _ -> #endif - cenv.localInternalVals.[v.Stamp] <- vval; + cenv.localInternalVals.[v.Stamp] <- vval env let BindExternalLocalVal cenv (v:Val) vval env = #if CHECKED - CheckInlineValueIsComplete v vval; + CheckInlineValueIsComplete v vval #endif - if verboseOptimizationInfo then dprintn ("*** Binding "^v.LogicalName); let vval = if v.IsMutable then {vval with ValExprInfo=UnknownValue } else vval let env = #if CHECKED @@ -490,17 +489,10 @@ let BindTypeVarsToUnknown (tps:Typar list) env = let nms = PrettyTypes.PrettyTyparNames (fun _ -> true) (env.typarInfos |> List.map (fun (tp,_) -> tp.Name) ) tps (tps,nms) ||> List.iter2 (fun tp nm -> if PrettyTypes.NeedsPrettyTyparName tp then - tp.Data.typar_id <- ident (nm,tp.Range)); + tp.Data.typar_id <- ident (nm,tp.Range)) List.fold (fun sofar arg -> BindTypeVar arg UnknownTypeValue sofar) env tps -let BindCcu (ccu:Tast.CcuThunk) mval env (g:TcGlobals) = -#if DEBUG - if verboseOptimizationInfo then - dprintf "*** Reloading optimization data for assembly %s, info = \n%s\n" ccu.AssemblyName (showL (Layout.squashTo 192 (moduleInfoL g mval))); -#else - ignore g -#endif - +let BindCcu (ccu:Tast.CcuThunk) mval env (_g:TcGlobals) = { env with globalModuleInfos=env.globalModuleInfos.Add(ccu.AssemblyName,mval) } @@ -521,9 +513,9 @@ let GetInfoForLocalValue cenv env (v:Val) m = | Some vval -> vval | None -> if v.MustInline then - errorR(Error(FSComp.SR.optValueMarkedInlineButWasNotBoundInTheOptEnv(fullDisplayTextOfValRef (mkLocalValRef v)), m)); + errorR(Error(FSComp.SR.optValueMarkedInlineButWasNotBoundInTheOptEnv(fullDisplayTextOfValRef (mkLocalValRef v)), m)) #if CHECKED - warning(Error(FSComp.SR.optLocalValueNotFoundDuringOptimization(v.DisplayName),m)); + warning(Error(FSComp.SR.optLocalValueNotFoundDuringOptimization(v.DisplayName),m)) #endif UnknownValInfo @@ -532,10 +524,7 @@ let TryGetInfoForCcu env (ccu:CcuThunk) = env.globalModuleInfos.TryFind(ccu.Asse let TryGetInfoForEntity sv n = match sv.ModuleOrNamespaceInfos.TryFind n with | Some info -> Some (info.Force()) - | None -> - if verboseOptimizationInfo then - dprintn ("\n\n*** Optimization info for submodule "^n^" not found in parent module which contains submodules: "^String.concat "," (NameMap.domainL sv.ModuleOrNamespaceInfos)); - None + | None -> None let rec TryGetInfoForPath sv (p:_[]) i = if i >= p.Length then Some sv else @@ -558,7 +547,7 @@ let GetInfoForNonLocalVal cenv env (vref:ValRef) = match structInfo.ValInfos.TryFind(vref) with | Some ninfo -> snd ninfo | None -> - //dprintn ("\n\n*** Optimization info for value "^n^" from module "^(full_name_of_nlpath smv)^" not found, module contains values: "^String.concat "," (NameMap.domainL structInfo.ValInfos)); + //dprintn ("\n\n*** Optimization info for value "+n+" from module "+(full_name_of_nlpath smv)+" not found, module contains values: "+String.concat "," (NameMap.domainL structInfo.ValInfos)) //System.Diagnostics.Debug.Assert(false,sprintf "Break for module %s, value %s" (full_name_of_nlpath smv) n) if cenv.g.compilingFslib then match structInfo.ValInfos.TryFindForFslib(vref) with @@ -568,7 +557,7 @@ let GetInfoForNonLocalVal cenv env (vref:ValRef) = else UnknownValInfo | None -> - //dprintf "\n\n*** Optimization info for module %s from ccu %s not found." (full_name_of_nlpath smv) (ccu_of_nlpath smv).AssemblyName; + //dprintf "\n\n*** Optimization info for module %s from ccu %s not found." (full_name_of_nlpath smv) (ccu_of_nlpath smv).AssemblyName //System.Diagnostics.Debug.Assert(false,sprintf "Break for module %s, ccu %s" (full_name_of_nlpath smv) (ccu_of_nlpath smv).AssemblyName) UnknownValInfo else @@ -579,7 +568,7 @@ let GetInfoForVal cenv env m (vref:ValRef) = match vref.IsLocalRef with | true -> GetInfoForLocalValue cenv env vref.binding m | false -> GetInfoForNonLocalVal cenv env vref - check (* "its stored value was incomplete" m *) vref res |> ignore; + check (* "its stored value was incomplete" m *) vref res |> ignore res //------------------------------------------------------------------------- @@ -639,9 +628,9 @@ let MakeValueInfoForValue g m vref vinfo = | ValValue (vref2,detail) -> if valRefEq g vref vref2 then error(Error(FSComp.SR.optRecursiveValValue(showL(exprValueInfoL g vinfo)),m)) else check detail | SizeValue (_n,detail) -> check detail | _ -> () - check vinfo; + check vinfo #else - ignore g; ignore m; + ignore g; ignore m #endif ValValue (vref,vinfo) |> BoundValueInfoBySize @@ -978,17 +967,17 @@ let NoFlatExprs : (FlatExprs * FlatList>) = FlatList.empt //------------------------------------------------------------------------- let CombineValueInfos einfos res = - { TotalSize = AddTotalSizes einfos; - FunctionSize = AddFunctionSizes einfos; - HasEffect = OrEffects einfos; - MightMakeCriticalTailcall = OrTailcalls einfos; + { TotalSize = AddTotalSizes einfos + FunctionSize = AddFunctionSizes einfos + HasEffect = OrEffects einfos + MightMakeCriticalTailcall = OrTailcalls einfos Info = res } let CombineFlatValueInfos einfos res = - { TotalSize = AddTotalSizesFlat einfos; - FunctionSize = AddFunctionSizesFlat einfos; - HasEffect = OrEffectsFlat einfos; - MightMakeCriticalTailcall = OrTailcallsFlat einfos; + { TotalSize = AddTotalSizesFlat einfos + FunctionSize = AddFunctionSizesFlat einfos + HasEffect = OrEffectsFlat einfos + MightMakeCriticalTailcall = OrTailcallsFlat einfos Info = res } let CombineValueInfosUnknown einfos = CombineValueInfos einfos UnknownValue @@ -1011,7 +1000,6 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = Zset.memberOf mhi.mhiUnionCases let rec abstractExprInfo ivalue = - if verboseOptimizationInfo then dprintf "abstractExprInfo\n"; match ivalue with (* Check for escaping value. Revert to old info if possible *) | ValValue (vref2,detail) -> @@ -1057,11 +1045,10 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = | CurriedLambdaValue _ | ConstValue _ -> ivalue and abstractValInfo v = - { ValExprInfo=abstractExprInfo v.ValExprInfo; + { ValExprInfo=abstractExprInfo v.ValExprInfo ValMakesNoCriticalTailcalls=v.ValMakesNoCriticalTailcalls } and abstractModulInfo ss = - if verboseOptimizationInfo then dprintf "abstractModulInfo\n"; - { ModuleOrNamespaceInfos = NameMap.map abstractLazyModulInfo ss.ModuleOrNamespaceInfos; + { ModuleOrNamespaceInfos = NameMap.map abstractLazyModulInfo ss.ModuleOrNamespaceInfos ValInfos = ValInfos(ss.ValInfos.Entries |> Seq.filter (fun (vref,_) -> not (hiddenVal vref.Deref)) @@ -1075,7 +1062,7 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = let AbstractOptimizationInfoToEssentials = let rec abstractModulInfo (ss:ModuleInfo) = - { ModuleOrNamespaceInfos = NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) ss.ModuleOrNamespaceInfos; + { ModuleOrNamespaceInfos = NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) ss.ModuleOrNamespaceInfos ValInfos = ss.ValInfos.Filter (fun (v,_) -> v.MustInline) } and abstractLazyModulInfo ss = ss |> Lazy.force |> abstractModulInfo |> notlazy @@ -1105,14 +1092,9 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = let ftyvs = freeInVal CollectTypars v2 List.exists (Zset.memberOf ftyvs.FreeTypars) boundTyVars) -> - if verboseOptimizationInfo then - dprintf "hiding value '%s' when used in expression (see %a)\n" v2.LogicalName outputRange v2.Range; - let ftyvs = freeInVal CollectTypars v2 - ftyvs.FreeTypars |> Zset.iter (fun v -> dprintf " -- ftyv %s @ %a\n" v.Name outputRange v.Range); - boundVars |> List.iter (fun v -> dprintf " -- bv %s @ %a\n" v.LogicalName outputRange v.Range); - boundTyVars |> List.iter (fun v -> dprintf " -- btyv %s @ %a\n" v.Name outputRange v.Range) - + // hiding value when used in expression abstractExprInfo detail + | ValValue (v2,detail) -> let detail' = abstractExprInfo detail ValValue (v2,detail') @@ -1123,14 +1105,8 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = (nonNil boundVars && List.exists (Zset.memberOf fvs.FreeLocals) boundVars) || (nonNil boundTyVars && List.exists (Zset.memberOf fvs.FreeTyvars.FreeTypars) boundTyVars) || (fvs.UsesMethodLocalConstructs )) -> - if verboseOptimizationInfo then - let fvs = freeInExpr (if isNil boundTyVars then CollectLocals else CollectTyparsAndLocals) expr - dprintf "Trimming lambda @ %a, UsesMethodLocalConstructs = %b, exprL = %s\n" outputRange expr.Range fvs.UsesMethodLocalConstructs (showL (exprL expr)); - fvs.FreeLocals |> Zset.iter (fun v -> dprintf "fv %s @ %a\n" v.LogicalName outputRange v.Range); - fvs.FreeTyvars.FreeTypars |> Zset.iter (fun v -> dprintf "ftyv %s @ %a\n" v.Name outputRange v.Range); - boundVars |> List.iter (fun v -> dprintf "bv %s @ %a\n" v.LogicalName outputRange v.Range); - boundTyVars |> List.iter (fun v -> dprintf "btyv %s @ %a\n" v.Name outputRange v.Range) - + + // Trimming lambda UnknownValue // Check for escape in generic constant @@ -1151,14 +1127,13 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = | SizeValue (_vdepth,vinfo) -> MakeSizedValueInfo (abstractExprInfo vinfo) and abstractValInfo v = - { ValExprInfo=abstractExprInfo v.ValExprInfo; + { ValExprInfo=abstractExprInfo v.ValExprInfo ValMakesNoCriticalTailcalls=v.ValMakesNoCriticalTailcalls } and abstractModulInfo ss = - { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) ; + { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) ValInfos = ss.ValInfos.Map (fun (vref,e) -> - if verboseOptimizationInfo then dprintf "checking %s @ %a\n" vref.LogicalName outputRange (vref.Range); - check (* "its implementation uses a private binding" m *) vref (abstractValInfo e) ) } + check vref (abstractValInfo e) ) } abstractExprInfo ivalue @@ -1169,7 +1144,6 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = let RemapOptimizationInfo g tmenv = let rec remapExprInfo ivalue = - if verboseOptimizationInfo then dprintf "remapExprInfo\n"; match ivalue with | ValValue (v,detail) -> ValValue (remapValRef tmenv v,remapExprInfo detail) | TupleValue vinfos -> TupleValue (Array.map remapExprInfo vinfos) @@ -1183,8 +1157,7 @@ let RemapOptimizationInfo g tmenv = let remapValInfo v = { ValExprInfo=remapExprInfo v.ValExprInfo; ValMakesNoCriticalTailcalls=v.ValMakesNoCriticalTailcalls } let rec remapModulInfo ss = - if verboseOptimizationInfo then dprintf "remapModulInfo\n"; - { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map remapLazyModulInfo; + { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map remapLazyModulInfo ValInfos = ss.ValInfos.Map (fun (vref,vinfo) -> let vref' = remapValRef tmenv vref let vinfo = remapValInfo vinfo @@ -1204,17 +1177,17 @@ let RemapOptimizationInfo g tmenv = let AbstractAndRemapModulInfo msg g m (repackage,hidden) info = let mrpi = mkRepackageRemapping repackage #if DEBUG - if verboseOptimizationInfo then dprintf "%s - %a - Optimization data prior to trim: \n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))); + if verboseOptimizationInfo then dprintf "%s - %a - Optimization data prior to trim: \n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))) #else ignore (msg,m) #endif let info = info |> AbstractLazyModulInfoByHiding false hidden #if DEBUG - if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after trim:\n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))); + if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after trim:\n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))) #endif let info = info |> RemapOptimizationInfo g mrpi #if DEBUG - if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after remap:\n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))); + if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after remap:\n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))) #endif info @@ -1254,6 +1227,7 @@ let ValueIsUsedOrHasEffect cenv fvs (b:Binding,binfo) = not (cenv.settings.EliminateUnusedBindings()) || isSome v.MemberInfo || binfo.HasEffect || + v.IsFixed || Zset.contains v (fvs()) let rec SplitValuesByIsUsedOrHasEffect cenv fvs x = @@ -1320,7 +1294,8 @@ and OpHasEffect g op = | TOp.ExnFieldGet(ecref,n) -> isExnFieldMutable ecref n | TOp.RefAddrGet -> false | TOp.ValFieldGet rfref -> rfref.RecdField.IsMutable || (TryFindTyconRefBoolAttribute g Range.range0 g.attrib_AllowNullLiteralAttribute rfref.TyconRef = Some(true)) - | TOp.ValFieldGetAddr _rfref -> true (* check *) + | TOp.ValFieldGetAddr rfref -> rfref.RecdField.IsMutable (* data is immutable, so taking address is ok *) + | TOp.UnionCaseFieldGetAddr _ -> false (* data is immutable, so taking address is ok *) | TOp.LValueOp (LGetAddr,lv) -> lv.IsMutable | TOp.UnionCaseFieldSet _ | TOp.ExnFieldSet _ @@ -1344,6 +1319,7 @@ let TryEliminateBinding cenv _env (TBind(vspec1,e1,spBind)) e2 _m = if not (cenv.optimizing && cenv.settings.EliminateImmediatelyConsumedLocals()) && not vspec1.IsCompilerGenerated then None + elif vspec1.IsFixed then None else // Peephole on immediate consumption of single bindings, e.g. "let x = e in x" --> "e" // REVIEW: enhance this by general elimination of bindings to @@ -1453,7 +1429,7 @@ let ExpandStructuralBindingRaw cenv expr = else let argTys = destTupleTy cenv.g v.Type let argBind i (arg:Expr) argTy = - let name = v.LogicalName ^ "_" ^ string i + let name = v.LogicalName + "_" + string i let v,ve = mkCompGenLocal arg.Range name argTy ve,mkCompGenBind v arg @@ -1730,10 +1706,10 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = | Expr.Quote(ast,splices,isFromQueryExpression,m,ty) -> let splices = ref (splices.Value |> Option.map (map3Of4 (List.map (OptimizeExpr cenv env >> fst)))) Expr.Quote(ast,splices,isFromQueryExpression,m,ty), - { TotalSize = 10; - FunctionSize = 1; - HasEffect = false; - MightMakeCriticalTailcall=false; + { TotalSize = 10 + FunctionSize = 1 + HasEffect = false + MightMakeCriticalTailcall=false Info=UnknownValue } | Expr.Obj (_,typ,basev,expr,overrides,iimpls,m) -> OptimizeObjectExpr cenv env (typ,basev,expr,overrides,iimpls,m) | Expr.Op (c,tyargs,args,m) -> OptimizeExprOp cenv env (c,tyargs,args,m) @@ -1758,13 +1734,13 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = let e2',e2info = OptimizeExpr cenv env e2 let e3',e3info = OptimizeExpr cenv env e3 Expr.StaticOptimization(constraints,e2',e3',m), - { TotalSize = min e2info.TotalSize e3info.TotalSize; - FunctionSize = min e2info.FunctionSize e3info.FunctionSize; - HasEffect = e2info.HasEffect || e3info.HasEffect; + { TotalSize = min e2info.TotalSize e3info.TotalSize + FunctionSize = min e2info.FunctionSize e3info.FunctionSize + HasEffect = e2info.HasEffect || e3info.HasEffect MightMakeCriticalTailcall=e2info.MightMakeCriticalTailcall || e3info.MightMakeCriticalTailcall // seems conservative Info= UnknownValue } | Expr.Link _eref -> - assert ("unexpected reclink" = ""); + assert ("unexpected reclink" = "") failwith "Unexpected reclink" @@ -1773,15 +1749,14 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = //------------------------------------------------------------------------- and OptimizeObjectExpr cenv env (typ,baseValOpt,basecall,overrides,iimpls,m) = - if verboseOptimizations then dprintf "OptimizeObjectExpr\n"; let basecall',basecallinfo = OptimizeExpr cenv env basecall let overrides',overrideinfos = OptimizeMethods cenv env baseValOpt overrides let iimpls',iimplsinfos = OptimizeInterfaceImpls cenv env baseValOpt iimpls let expr'=mkObjExpr(typ,baseValOpt,basecall',overrides',iimpls',m) - expr', { TotalSize=closureTotalSize + basecallinfo.TotalSize + AddTotalSizes overrideinfos + AddTotalSizes iimplsinfos; - FunctionSize=1 (* a newobj *) ; - HasEffect=true; - MightMakeCriticalTailcall=false; // creating an object is not a useful tailcall + expr', { TotalSize=closureTotalSize + basecallinfo.TotalSize + AddTotalSizes overrideinfos + AddTotalSizes iimplsinfos + FunctionSize=1 (* a newobj *) + HasEffect=true + MightMakeCriticalTailcall=false // creating an object is not a useful tailcall Info=UnknownValue} //------------------------------------------------------------------------- @@ -1790,7 +1765,6 @@ and OptimizeObjectExpr cenv env (typ,baseValOpt,basecall,overrides,iimpls,m) = and OptimizeMethods cenv env baseValOpt l = OptimizeList (OptimizeMethod cenv env baseValOpt) l and OptimizeMethod cenv env baseValOpt (TObjExprMethod(slotsig, attribs, tps, vs, e, m) as tmethod) = - if verboseOptimizations then dprintf "OptimizeMethod\n"; let env = {env with latestBoundId=Some tmethod.Id; functionVal = None} let env = BindTypeVarsToUnknown tps env let env = BindInternalValsToUnknown cenv vs env @@ -1798,10 +1772,10 @@ and OptimizeMethod cenv env baseValOpt (TObjExprMethod(slotsig, attribs, tps, vs let e',einfo = OptimizeExpr cenv env e (* REVIEW: if we ever change this from being UnknownValue then we should call AbstractExprInfoByVars *) TObjExprMethod(slotsig,attribs,tps,vs,e',m), - { TotalSize = einfo.TotalSize; - FunctionSize = 0; - HasEffect = false; - MightMakeCriticalTailcall=false; + { TotalSize = einfo.TotalSize + FunctionSize = 0 + HasEffect = false + MightMakeCriticalTailcall=false Info=UnknownValue} //------------------------------------------------------------------------- @@ -1810,13 +1784,12 @@ and OptimizeMethod cenv env baseValOpt (TObjExprMethod(slotsig, attribs, tps, vs and OptimizeInterfaceImpls cenv env baseValOpt l = OptimizeList (OptimizeInterfaceImpl cenv env baseValOpt) l and OptimizeInterfaceImpl cenv env baseValOpt (ty,overrides) = - if verboseOptimizations then dprintf "OptimizeInterfaceImpl\n"; let overrides',overridesinfos = OptimizeMethods cenv env baseValOpt overrides (ty, overrides'), - { TotalSize = AddTotalSizes overridesinfos; - FunctionSize = 1; - HasEffect = false; - MightMakeCriticalTailcall=false; + { TotalSize = AddTotalSizes overridesinfos + FunctionSize = 1 + HasEffect = false + MightMakeCriticalTailcall=false Info=UnknownValue} //------------------------------------------------------------------------- @@ -1825,7 +1798,6 @@ and OptimizeInterfaceImpl cenv env baseValOpt (ty,overrides) = and OptimizeExprOp cenv env (op,tyargs,args,m) = - if verboseOptimizations then dprintf "OptimizeExprOp\n"; (* Special cases *) match op,tyargs,args with | TOp.Coerce,[toty;fromty],[e] -> @@ -1833,10 +1805,10 @@ and OptimizeExprOp cenv env (op,tyargs,args,m) = if typeEquiv cenv.g toty fromty then e',einfo else mkCoerceExpr(e',toty,m,fromty), - { TotalSize=einfo.TotalSize + 1; - FunctionSize=einfo.FunctionSize + 1; - HasEffect = true; - MightMakeCriticalTailcall=false; + { TotalSize=einfo.TotalSize + 1 + FunctionSize=einfo.FunctionSize + 1 + HasEffect = true + MightMakeCriticalTailcall=false Info=UnknownValue } (* Handle addresses *) | TOp.LValueOp (LGetAddr,lv),_,_ -> @@ -1847,10 +1819,10 @@ and OptimizeExprOp cenv env (op,tyargs,args,m) = | Expr.Val (v,_,_) when not v.IsCompiledAsTopLevel -> TOp.LValueOp (LGetAddr,v) | _ -> op Expr.Op (op',tyargs,args,m), - { TotalSize = 1; - FunctionSize = 1; - HasEffect = OpHasEffect cenv.g op'; - MightMakeCriticalTailcall = false; + { TotalSize = 1 + FunctionSize = 1 + HasEffect = OpHasEffect cenv.g op' + MightMakeCriticalTailcall = false Info = UnknownValue } (* Handle these as special cases since mutables are allowed inside their bodies *) | TOp.While (spWhile,marker),_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_)] -> OptimizeWhileLoop cenv env (spWhile,marker,e1,e2,m) @@ -1928,6 +1900,7 @@ and OptimizeExprOpFallback cenv env (op,tyargs,args',m) arginfos valu = | TOp.Array | TOp.For _ | TOp.While _ | TOp.TryCatch _ | TOp.TryFinally _ | TOp.ILCall _ | TOp.TraitCall _ | TOp.LValueOp _ | TOp.ValFieldSet _ | TOp.UnionCaseFieldSet _ | TOp.RefAddrGet | TOp.Coerce | TOp.Reraise + | TOp.UnionCaseFieldGetAddr _ | TOp.ExnFieldSet _ -> 1,valu | TOp.Recd (ctorInfo,tcref) -> let finfos = tcref.AllInstanceFieldsAsList @@ -1948,10 +1921,10 @@ and OptimizeExprOpFallback cenv env (op,tyargs,args',m) arginfos valu = | TOp.ILCall (virt,_,newobj,_,_,_,_,_,_,_,_) -> not newobj && virt | _ -> false - let vinfo = { TotalSize=argsTSize + cost; - FunctionSize=argsFSize + cost; - HasEffect=argEffects || effect; - MightMakeCriticalTailcall= mayBeCriticalTailcall; // discard tailcall info for args - these are not in tailcall position + let vinfo = { TotalSize=argsTSize + cost + FunctionSize=argsFSize + cost + HasEffect=argEffects || effect + MightMakeCriticalTailcall= mayBeCriticalTailcall // discard tailcall info for args - these are not in tailcall position Info=valu } // Replace entire expression with known value? @@ -1959,10 +1932,10 @@ and OptimizeExprOpFallback cenv env (op,tyargs,args',m) arginfos valu = | Some res -> res,vinfo | None -> Expr.Op(op,tyargs,args',m), - { TotalSize=argsTSize + cost; - FunctionSize=argsFSize + cost; - HasEffect=argEffects || effect; - MightMakeCriticalTailcall= mayBeCriticalTailcall; // discard tailcall info for args - these are not in tailcall position + { TotalSize=argsTSize + cost + FunctionSize=argsFSize + cost + HasEffect=argEffects || effect + MightMakeCriticalTailcall= mayBeCriticalTailcall // discard tailcall info for args - these are not in tailcall position Info=valu } //------------------------------------------------------------------------- @@ -1974,13 +1947,12 @@ and OptimizeConst cenv env expr (c,m,ty) = | Some(e) -> OptimizeExpr cenv env e | None -> - if verboseOptimizations then dprintf "OptimizeConst\n"; expr, { TotalSize=(match c with | Const.String b -> b.Length/10 - | _ -> 0); - FunctionSize=0; - HasEffect=false; - MightMakeCriticalTailcall=false; + | _ -> 0) + FunctionSize=0 + HasEffect=false + MightMakeCriticalTailcall=false Info=MakeValueInfoForConst c ty} //------------------------------------------------------------------------- @@ -1991,7 +1963,7 @@ and TryOptimizeRecordFieldGet cenv _env (e1info,r:RecdFieldRef,_tinst,m) = match destRecdValue e1info.Info with | Some finfos when cenv.settings.EliminateRecdFieldGet() && not e1info.HasEffect -> let n = r.Index - if n >= finfos.Length then errorR(InternalError( "TryOptimizeRecordFieldGet: term argument out of range",m)); + if n >= finfos.Length then errorR(InternalError( "TryOptimizeRecordFieldGet: term argument out of range",m)) Some finfos.[n] (* Uses INVARIANT on record ValInfos that exprs are in defn order *) | _ -> None @@ -1999,15 +1971,15 @@ and TryOptimizeTupleFieldGet cenv _env (e1info,tys,n,m) = match destTupleValue e1info.Info with | Some tups when cenv.settings.EliminateTupleFieldGet() && not e1info.HasEffect -> let len = tups.Length - if len <> tys.Length then errorR(InternalError("error: tuple lengths don't match",m)); - if n >= len then errorR(InternalError("TryOptimizeTupleFieldGet: tuple index out of range",m)); + if len <> tys.Length then errorR(InternalError("error: tuple lengths don't match",m)) + if n >= len then errorR(InternalError("TryOptimizeTupleFieldGet: tuple index out of range",m)) Some tups.[n] | _ -> None and TryOptimizeUnionCaseGet cenv _env (e1info,cspec,_tys,n,m) = match e1info.Info with | StripUnionCaseValue(cspec2,args) when cenv.settings.EliminatUnionCaseFieldGet() && not e1info.HasEffect && cenv.g.unionCaseRefEq cspec cspec2 -> - if n >= args.Length then errorR(InternalError( "TryOptimizeUnionCaseGet: term argument out of range",m)); + if n >= args.Length then errorR(InternalError( "TryOptimizeUnionCaseGet: term argument out of range",m)) Some args.[n] | _ -> None @@ -2016,7 +1988,6 @@ and TryOptimizeUnionCaseGet cenv _env (e1info,cspec,_tys,n,m) = //------------------------------------------------------------------------- and OptimizeFastIntegerForLoop cenv env (spStart,v,e1,dir,e2,e3,m) = - if verboseOptimizations then dprintf "OptimizeFastIntegerForLoop\n"; let e1',e1info = OptimizeExpr cenv env e1 let e2',e2info = OptimizeExpr cenv env e2 let env = BindInternalValToUnknown cenv v env @@ -2027,8 +1998,7 @@ and OptimizeFastIntegerForLoop cenv env (spStart,v,e1,dir,e2,e3,m) = let e2', dir = match dir, e2' with // detect upwards for loops with bounds of the form "arr.Length - 1" and convert them to a C#-style for loop - | FSharpForLoopUp, Expr.Op(TOp.ILAsm([ (AI_sub | AI_sub_ovf)],_),_,[Expr.Op(TOp.ILAsm([ I_ldlen; (AI_conv DT_I4)],_),_,[arre],_); - Expr.Const(Const.Int32 1,_,_)],_) + | FSharpForLoopUp, Expr.Op(TOp.ILAsm([ (AI_sub | AI_sub_ovf)],_),_,[Expr.Op(TOp.ILAsm([ I_ldlen; (AI_conv DT_I4)],_),_,[arre],_); Expr.Const(Const.Int32 1,_,_)],_) when not (snd(OptimizeExpr cenv env arre)).HasEffect -> mkLdlen cenv.g (e2'.Range) arre, CSharpForLoopUp @@ -2048,10 +2018,10 @@ and OptimizeFastIntegerForLoop cenv env (spStart,v,e1,dir,e2,e3,m) = mkUnit cenv.g m , { TotalSize=0; FunctionSize=0; HasEffect=false; MightMakeCriticalTailcall=false; Info=UnknownValue } else let expr' = mkFor cenv.g (spStart,v,e1',dir,e2',e3',m) - expr', { TotalSize=AddTotalSizes einfos + forAndWhileLoopSize; - FunctionSize=AddFunctionSizes einfos + forAndWhileLoopSize; - HasEffect=eff; - MightMakeCriticalTailcall=false; + expr', { TotalSize=AddTotalSizes einfos + forAndWhileLoopSize + FunctionSize=AddFunctionSizes einfos + forAndWhileLoopSize + HasEffect=eff + MightMakeCriticalTailcall=false Info=UnknownValue } //------------------------------------------------------------------------- @@ -2059,7 +2029,6 @@ and OptimizeFastIntegerForLoop cenv env (spStart,v,e1,dir,e2,e3,m) = //------------------------------------------------------------------------- and OptimizeLetRec cenv env (binds,bodyExpr,m) = - if verboseOptimizations then dprintf "OptimizeLetRec\n"; let vs = binds |> FlatList.map (fun v -> v.Var) in let env = BindInternalValsToUnknown cenv vs env let binds',env = OptimizeBindings cenv true env binds @@ -2086,11 +2055,9 @@ and OptimizeLinearExpr cenv env expr contf = let expr = DetectAndOptimizeForExpression cenv.g OptimizeAllForExpressions expr - if verboseOptimizations then dprintf "OptimizeLinearExpr\n"; let expr = if cenv.settings.ExpandStructrualValues() then ExpandStructuralBinding cenv expr else expr match expr with | Expr.Sequential (e1,e2,flag,spSeq,m) -> - if verboseOptimizations then dprintf "OptimizeLinearExpr: seq\n"; let e1',e1info = OptimizeExpr cenv env e1 OptimizeLinearExpr cenv env e2 (contf << (fun (e2',e2info) -> if (flag = NormalSeq) && @@ -2101,14 +2068,13 @@ and OptimizeLinearExpr cenv env expr contf = e2', e2info else Expr.Sequential(e1',e2',flag,spSeq,m), - { TotalSize = e1info.TotalSize + e2info.TotalSize; - FunctionSize = e1info.FunctionSize + e2info.FunctionSize; - HasEffect = flag <> NormalSeq || e1info.HasEffect || e2info.HasEffect; + { TotalSize = e1info.TotalSize + e2info.TotalSize + FunctionSize = e1info.FunctionSize + e2info.FunctionSize + HasEffect = flag <> NormalSeq || e1info.HasEffect || e2info.HasEffect MightMakeCriticalTailcall = (if flag = NormalSeq then e2info.MightMakeCriticalTailcall else e1info.MightMakeCriticalTailcall || e2info.MightMakeCriticalTailcall) Info = UnknownValue (* can't propagate value: must access result of computation for its effects *) })) | Expr.Let (bind,body,m,_) -> - if verboseOptimizations then dprintf "OptimizeLinearExpr: let\n"; let (bind',bindingInfo),env = OptimizeBinding cenv false env bind OptimizeLinearExpr cenv env body (contf << (fun (body',bodyInfo) -> // PERF: This call to ValueIsUsedOrHasEffect/freeInExpr amounts to 9% of all optimization time. @@ -2117,19 +2083,19 @@ and OptimizeLinearExpr cenv env expr contf = (* Eliminate let bindings on the way back up *) let expr',adjust = TryEliminateLet cenv env bind' body' m expr', - { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize + adjust; - FunctionSize = bindingInfo.FunctionSize + bodyInfo.FunctionSize + adjust; - HasEffect=bindingInfo.HasEffect || bodyInfo.HasEffect; - MightMakeCriticalTailcall = bodyInfo.MightMakeCriticalTailcall; // discard tailcall info from binding - not in tailcall position + { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize + adjust + FunctionSize = bindingInfo.FunctionSize + bodyInfo.FunctionSize + adjust + HasEffect=bindingInfo.HasEffect || bodyInfo.HasEffect + MightMakeCriticalTailcall = bodyInfo.MightMakeCriticalTailcall // discard tailcall info from binding - not in tailcall position Info = UnknownValue } else (* On the way back up: Trim out any optimization info that involves escaping values on the way back up *) let evalue' = AbstractExprInfoByVars ([bind'.Var],[]) bodyInfo.Info body', - { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize - localVarSize (* eliminated a local var *); - FunctionSize = bindingInfo.FunctionSize + bodyInfo.FunctionSize - localVarSize (* eliminated a local var *); - HasEffect=bindingInfo.HasEffect || bodyInfo.HasEffect; - MightMakeCriticalTailcall = bodyInfo.MightMakeCriticalTailcall; // discard tailcall info from binding - not in tailcall position + { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize - localVarSize (* eliminated a local var *) + FunctionSize = bindingInfo.FunctionSize + bodyInfo.FunctionSize - localVarSize (* eliminated a local var *) + HasEffect=bindingInfo.HasEffect || bodyInfo.HasEffect + MightMakeCriticalTailcall = bodyInfo.MightMakeCriticalTailcall // discard tailcall info from binding - not in tailcall position Info = evalue' } )) | LinearMatchExpr (spMatch,exprm,dtree,tg1,e2,spTarget2,m,ty) -> @@ -2149,14 +2115,13 @@ and OptimizeLinearExpr cenv env expr contf = //------------------------------------------------------------------------- and OptimizeTryFinally cenv env (spTry,spFinally,e1,e2,m,ty) = - if verboseOptimizations then dprintf "OptimizeTryFinally\n"; let e1',e1info = OptimizeExpr cenv env e1 let e2',e2info = OptimizeExpr cenv env e2 let info = - { TotalSize = e1info.TotalSize + e2info.TotalSize + tryFinallySize; - FunctionSize = e1info.FunctionSize + e2info.FunctionSize + tryFinallySize; - HasEffect = e1info.HasEffect || e2info.HasEffect; - MightMakeCriticalTailcall = false; // no tailcalls from inside in try/finally + { TotalSize = e1info.TotalSize + e2info.TotalSize + tryFinallySize + FunctionSize = e1info.FunctionSize + e2info.FunctionSize + tryFinallySize + HasEffect = e1info.HasEffect || e2info.HasEffect + MightMakeCriticalTailcall = false // no tailcalls from inside in try/finally Info = UnknownValue } (* try-finally, so no effect means no exception can be raised, so just sequence the finally *) if cenv.settings.EliminateTryCatchAndTryFinally () && not e1info.HasEffect then @@ -2175,7 +2140,6 @@ and OptimizeTryFinally cenv env (spTry,spFinally,e1,e2,m,ty) = //------------------------------------------------------------------------- and OptimizeTryCatch cenv env (e1,vf,ef,vh,eh,m,ty,spTry,spWith) = - if verboseOptimizations then dprintf "OptimizeTryCatch\n"; let e1',e1info = OptimizeExpr cenv env e1 // try-catch, so no effect means no exception can be raised, so discard the catch if cenv.settings.EliminateTryCatchAndTryFinally () && not e1info.HasEffect then @@ -2185,10 +2149,10 @@ and OptimizeTryCatch cenv env (e1,vf,ef,vh,eh,m,ty,spTry,spWith) = let ef',efinfo = OptimizeExpr cenv envinner ef let eh',ehinfo = OptimizeExpr cenv envinner eh let info = - { TotalSize = e1info.TotalSize + efinfo.TotalSize+ ehinfo.TotalSize + tryCatchSize; - FunctionSize = e1info.FunctionSize + efinfo.FunctionSize+ ehinfo.FunctionSize + tryCatchSize; - HasEffect = e1info.HasEffect || efinfo.HasEffect || ehinfo.HasEffect; - MightMakeCriticalTailcall = false; + { TotalSize = e1info.TotalSize + efinfo.TotalSize+ ehinfo.TotalSize + tryCatchSize + FunctionSize = e1info.FunctionSize + efinfo.FunctionSize+ ehinfo.FunctionSize + tryCatchSize + HasEffect = e1info.HasEffect || efinfo.HasEffect || ehinfo.HasEffect + MightMakeCriticalTailcall = false Info = UnknownValue } mkTryWith cenv.g (e1',vf,ef',vh,eh',m,ty,spTry,spWith), info @@ -2198,14 +2162,13 @@ and OptimizeTryCatch cenv env (e1,vf,ef,vh,eh,m,ty,spTry,spWith) = //------------------------------------------------------------------------- and OptimizeWhileLoop cenv env (spWhile,marker,e1,e2,m) = - if verboseOptimizations then dprintf "OptimizeWhileLoop\n"; let e1',e1info = OptimizeExpr cenv env e1 let e2',e2info = OptimizeExpr cenv env e2 mkWhile cenv.g (spWhile,marker,e1',e2',m), - { TotalSize = e1info.TotalSize + e2info.TotalSize + forAndWhileLoopSize; - FunctionSize = e1info.FunctionSize + e2info.FunctionSize + forAndWhileLoopSize; - HasEffect = true; (* may not terminate *) - MightMakeCriticalTailcall = false; + { TotalSize = e1info.TotalSize + e2info.TotalSize + forAndWhileLoopSize + FunctionSize = e1info.FunctionSize + e2info.FunctionSize + forAndWhileLoopSize + HasEffect = true (* may not terminate *) + MightMakeCriticalTailcall = false Info = UnknownValue } //------------------------------------------------------------------------- @@ -2246,10 +2209,8 @@ and TryOptimizeVal cenv env (mustInline,valInfoForVal,m) = //If the more specific info didn't reveal an inline then use the value | None -> Some(exprForValRef m v') | ConstExprValue(_size,expr) -> - if verboseOptimizations then dprintf "Inlining constant expression value at %a\n" outputRange m; Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr)) | CurriedLambdaValue (_,_,_,expr,_) when mustInline -> - if verboseOptimizations then dprintf "Inlining mustinline-lambda at %a\n" outputRange m; Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr)) | TupleValue _ | UnionCaseValue _ | RecdValue _ when mustInline -> failwith "tuple, union and record values cannot be marked 'inline'" | UnknownValue when mustInline -> warning(Error(FSComp.SR.optValueMarkedInlineHasUnexpectedValue(),m)); None @@ -2284,22 +2245,22 @@ and OptimizeVal cenv env expr (v:ValRef,m) = | Expr.TyLambda _ | Expr.Lambda _ -> e, (AddValEqualityInfo cenv.g m v - { Info=valInfoForVal.ValExprInfo; - HasEffect=false; - MightMakeCriticalTailcall = false; - FunctionSize=10; + { Info=valInfoForVal.ValExprInfo + HasEffect=false + MightMakeCriticalTailcall = false + FunctionSize=10 TotalSize=10}) | _ -> let e,einfo = OptimizeExpr cenv env e e,AddValEqualityInfo cenv.g m v einfo | None -> - if v.MustInline then error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName),m)); + if v.MustInline then error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName),m)) expr,(AddValEqualityInfo cenv.g m v - { Info=valInfoForVal.ValExprInfo; - HasEffect=false; - MightMakeCriticalTailcall = false; - FunctionSize=1; + { Info=valInfoForVal.ValExprInfo + HasEffect=false + MightMakeCriticalTailcall = false + FunctionSize=1 TotalSize=1}) //------------------------------------------------------------------------- @@ -2536,21 +2497,21 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = // Don't fiddle with 'methodhandleof' calls - just remake the application | Expr.Val(vref,_,_),_,_ when valRefEq cenv.g vref cenv.g.methodhandleof_vref -> Some( MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref,vref.Type,(if isNil tyargs then [] else [tyargs]),args,m), - { TotalSize=1; + { TotalSize=1 FunctionSize=1 - HasEffect=false; - MightMakeCriticalTailcall = false; + HasEffect=false + MightMakeCriticalTailcall = false Info=UnknownValue}) | _ -> None /// Attempt to inline an application of a known value at callsites and TryInlineApplication cenv env (_f0',finfo) (tyargs: TType list,args: Expr list,m) = - if verboseOptimizations then dprintf "Considering inlining app near %a\n" outputRange m; + // Considering inlining app match finfo.Info with | StripLambdaValue (lambdaId,arities,size,f2,f2ty) when - (if verboseOptimizations then dprintf "Considering inlining lambda near %a, size = %d, finfo.HasEffect = %b\n" outputRange m size finfo.HasEffect; + (// Considering inlining lambda cenv.optimizing && cenv.settings.InlineLambdas () && not finfo.HasEffect && @@ -2558,9 +2519,9 @@ and TryInlineApplication cenv env (_f0',finfo) (tyargs: TType list,args: Expr li not (Zset.contains lambdaId env.dontInline) && (// Check the number of argument groups is enough to saturate the lambdas of the target. (if tyargs |> List.filter (fun t -> match t with TType_measure _ -> false | _ -> true) |> isNil then 0 else 1) + args.Length = arities && - (if verboseOptimizations then dprintn "Enough args"; + (// Enough args (if size > cenv.settings.lambdaInlineThreshold + args.Length then - if verboseOptimizations then dprintf "Not inlining lambda near %a because size = %d\n" outputRange m size; + // Not inlining lambda near, size too big false else true)))) -> @@ -2595,18 +2556,18 @@ and TryInlineApplication cenv env (_f0',finfo) (tyargs: TType list,args: Expr li if isBaseCall || isSecureMethod || isValFromLazyExtensions then None else - if verboseOptimizations then dprintf "Inlining lambda near %a\n" outputRange m; - (* ---------- printf "Inlining lambda near %a = %s\n" outputRange m (showL (exprL f2)); (* JAMES: *) ----------*) + // Inlining lambda + (* ---------- printf "Inlining lambda near %a = %s\n" outputRange m (showL (exprL f2)) (* JAMES: *) ----------*) let f2' = remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated f2) - if verboseOptimizations then dprintf "--- TryInlineApplication, optimizing arguments\n"; + // Optimizing arguments after inlining // REVIEW: this is a cheapshot way of optimizing the arg expressions as well without the restriction of recursive // inlining kicking into effect let args' = args |> List.map (fun e -> let e',_einfo = OptimizeExpr cenv env e in e') // Beta reduce. MakeApplicationAndBetaReduce cenv.g does all the hard work. - if verboseOptimizations then dprintf "--- TryInlineApplication, beta reducing \n"; + // Inlining: beta reducing let expr' = MakeApplicationAndBetaReduce cenv.g (f2',f2ty,[tyargs],args',m) - if verboseOptimizations then dprintf "--- TryInlineApplication, reoptimizing\n"; + // Inlining: reoptimizing Some (OptimizeExpr cenv {env with dontInline= Zset.add lambdaId env.dontInline} expr') | _ -> None @@ -2616,18 +2577,17 @@ and TryInlineApplication cenv env (_f0',finfo) (tyargs: TType list,args: Expr li //------------------------------------------------------------------------- and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = - if verboseOptimizations then dprintf "--> OptimizeApplication\n"; let f0',finfo = OptimizeExpr cenv env f0 - if verboseOptimizations then dprintf "--- OptimizeApplication, trying to devirtualize\n"; + // trying to devirtualize match TryDevirtualizeApplication cenv env (f0,tyargs,args,m) with | Some res -> - if verboseOptimizations then dprintf "<-- OptimizeApplication, devirtualized\n"; + // devirtualized res | None -> match TryInlineApplication cenv env (f0',finfo) (tyargs,args,m) with | Some res -> - if verboseOptimizations then dprintf "<-- OptimizeApplication, inlined\n"; + // inlined res | None -> @@ -2648,16 +2608,15 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = | _ -> args |> List.map (fun _ -> UnknownValue) let args',arginfos = OptimizeExprsThenReshapeAndConsiderSplits cenv env (List.zip shapes args) - if verboseOptimizations then dprintf "<-- OptimizeApplication, beta reducing\n"; + // beta reducing let expr' = MakeApplicationAndBetaReduce cenv.g (f0',f0ty, [tyargs],args',m) match f0', expr' with | (Expr.Lambda _ | Expr.TyLambda _), Expr.Let _ -> // we beta-reduced, hence reoptimize - if verboseOptimizations then dprintf "<-- OptimizeApplication, beta reduced\n"; OptimizeExpr cenv env expr' | _ -> - if verboseOptimizations then dprintf "<-- OptimizeApplication, regular\n"; + // regular // Determine if this application is a critical tailcall let mayBeCriticalTailcall = @@ -2686,10 +2645,10 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = // All indirect calls (calls to unknown functions) are assumed to be critical tailcalls true - expr', { TotalSize=finfo.TotalSize + AddTotalSizes arginfos; - FunctionSize=finfo.FunctionSize + AddFunctionSizes arginfos; - HasEffect=true; - MightMakeCriticalTailcall = mayBeCriticalTailcall; + expr', { TotalSize=finfo.TotalSize + AddTotalSizes arginfos + FunctionSize=finfo.FunctionSize + AddFunctionSizes arginfos + HasEffect=true + MightMakeCriticalTailcall = mayBeCriticalTailcall Info=ValueOfExpr expr' } //------------------------------------------------------------------------- @@ -2697,7 +2656,6 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = //------------------------------------------------------------------------- and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = - if verboseOptimizations then dprintf "OptimizeLambdas, #argsl = %d, %a\n" topValInfo.NumCurriedArgs outputRange (e.Range) ; match e with | Expr.Lambda (lambdaId,_,_,_,_,m,_) | Expr.TyLambda(lambdaId,_,_,m,_) -> @@ -2714,8 +2672,6 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = let arities = vsl.Length let arities = if isNil tps then arities else 1+arities let bsize = bodyinfo.TotalSize - if verboseOptimizations then dprintf "lambda @ %a, bsize = %d\n" outputRange m bsize; - /// Set the flag on the value indicating that direct calls can avoid a tailcall (which are expensive on .NET x86) /// MightMakeCriticalTailcall is true whenever the body of the method may itself do a useful tailcall, e.g. has @@ -2757,11 +2713,11 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = CurriedLambdaValue (lambdaId,arities,bsize,expr2,ety) - expr', { TotalSize=bsize + (if isTopLevel then methodDefnTotalSize else closureTotalSize); (* estimate size of new syntactic closure - expensive, in contrast to a method *) - FunctionSize=1; - HasEffect=false; - MightMakeCriticalTailcall = false; - Info= valu; } + expr', { TotalSize=bsize + (if isTopLevel then methodDefnTotalSize else closureTotalSize) (* estimate size of new syntactic closure - expensive, in contrast to a method *) + FunctionSize=1 + HasEffect=false + MightMakeCriticalTailcall = false + Info= valu } | _ -> OptimizeExpr cenv env e @@ -2832,7 +2788,8 @@ and ComputeSplitToMethodCondition flag threshold cenv env (e,einfo) = // None of them should be local polymorphic constrained values not (IsGenericValWithGenericContraints cenv.g v) && // None of them should be mutable - not v.IsMutable)))) + not v.IsMutable)))) && + not (isByrefLikeTy cenv.g (tyOfExpr cenv.g e)) and ConsiderSplitToMethod flag threshold cenv env (e,einfo) = if ComputeSplitToMethodCondition flag threshold cenv env (e,einfo) then @@ -2841,7 +2798,7 @@ and ConsiderSplitToMethod flag threshold cenv env (e,einfo) = let ty = tyOfExpr cenv.g e let nm = match env.latestBoundId with - | Some id -> id.idText^suffixForVariablesThatMayNotBeEliminated + | Some id -> id.idText+suffixForVariablesThatMayNotBeEliminated | None -> suffixForVariablesThatMayNotBeEliminated let fv,fe = mkCompGenLocal m nm (cenv.g.unit_ty --> ty) mkInvisibleLet m fv (mkLambda m uv (e,ty)) @@ -2855,17 +2812,16 @@ and ConsiderSplitToMethod flag threshold cenv env (e,einfo) = //------------------------------------------------------------------------- and OptimizeMatch cenv env (spMatch,exprm,dtree,targets,m, ty) = - if verboseOptimizations then dprintf "OptimizeMatch\n"; // REVIEW: consider collecting, merging and using information flowing through each line of the decision tree to each target let dtree',dinfo = OptimizeDecisionTree cenv env m dtree let targets',tinfos = OptimizeDecisionTreeTargets cenv env m targets RebuildOptimizedMatch (spMatch,exprm,m,ty,dtree',targets',dinfo,tinfos) and CombineMatchInfos dinfo tinfo = - { TotalSize = dinfo.TotalSize + tinfo.TotalSize; - FunctionSize = dinfo.FunctionSize + tinfo.FunctionSize; - HasEffect = dinfo.HasEffect || tinfo.HasEffect; - MightMakeCriticalTailcall=tinfo.MightMakeCriticalTailcall; // discard tailcall info from decision tree since it's not in tailcall position + { TotalSize = dinfo.TotalSize + tinfo.TotalSize + FunctionSize = dinfo.FunctionSize + tinfo.FunctionSize + HasEffect = dinfo.HasEffect || tinfo.HasEffect + MightMakeCriticalTailcall=tinfo.MightMakeCriticalTailcall // discard tailcall info from decision tree since it's not in tailcall position Info= UnknownValue } and RebuildOptimizedMatch (spMatch,exprm,m,ty,dtree,tgs,dinfo,tinfos) = @@ -2879,17 +2835,16 @@ and RebuildOptimizedMatch (spMatch,exprm,m,ty,dtree,tgs,dinfo,tinfos) = //------------------------------------------------------------------------- and OptimizeDecisionTreeTarget cenv env _m (TTarget(vs,e,spTarget)) = - if verboseOptimizations then dprintf "OptimizeDecisionTreeTarget\n"; (* REVIEW: this is where we should be using information collected for each target *) let env = BindInternalValsToUnknown cenv vs env let e',einfo = OptimizeExpr cenv env e let e',einfo = ConsiderSplitToMethod cenv.settings.abstractBigTargets cenv.settings.bigTargetSize cenv env (e',einfo) let evalue' = AbstractExprInfoByVars (FlatList.toList vs,[]) einfo.Info TTarget(vs,e',spTarget), - { TotalSize=einfo.TotalSize; - FunctionSize=einfo.FunctionSize; - HasEffect=einfo.HasEffect; - MightMakeCriticalTailcall = einfo.MightMakeCriticalTailcall; + { TotalSize=einfo.TotalSize + FunctionSize=einfo.FunctionSize + HasEffect=einfo.HasEffect + MightMakeCriticalTailcall = einfo.MightMakeCriticalTailcall Info=evalue' } //------------------------------------------------------------------------- @@ -2943,7 +2898,6 @@ and TryOptimizeDecisionTreeTest cenv test vinfo = /// Optimize/analyze a switch construct from pattern matching and OptimizeSwitch cenv env (e,cases,dflt,m) = - if verboseOptimizations then dprintf "OptimizeSwitch\n"; let e', einfo = OptimizeExpr cenv env e let cases,dflt = @@ -2972,7 +2926,6 @@ and OptimizeSwitchFallback cenv env (e', einfo, cases,dflt,m) = and OptimizeBinding cenv isRec env (TBind(v,e,spBind)) = try - if verboseOptimizations then dprintf "OptimizeBinding\n"; // The aim here is to stop method splitting for direct-self-tailcalls. We do more than that: if an expression // occurs in the body of recursively defined values RVS, then we refuse to split @@ -2995,12 +2948,12 @@ and OptimizeBinding cenv isRec env (TBind(v,e,spBind)) = match ivalue with | CurriedLambdaValue (_, arities, size, body,_) -> if size > (cenv.settings.lambdaInlineThreshold + arities + 2) then - if verboseOptimizations then dprintf "Discarding lambda for binding %s, size = %d, m = %a\n" v.LogicalName size outputRange body.Range; + // Discarding lambda for binding v.LogicalName UnknownValue (* trim large *) else let fvs = freeInExpr CollectLocals body if fvs.UsesMethodLocalConstructs then - if verboseOptimizations then dprintf "Discarding lambda for binding %s because uses protected members, m = %a\n" v.LogicalName outputRange body.Range; + // Discarding lambda for bindingbecause uses protected members UnknownValue (* trim protected *) else ivalue @@ -3061,15 +3014,12 @@ and OptimizeBinding cenv isRec env (TBind(v,e,spBind)) = then {einfo with Info=UnknownValue} else einfo if v.MustInline && IsPartialExprVal einfo.Info then - errorR(InternalError("the mustinline value '"^v.LogicalName^"' was not inferred to have a known value",v.Range)); -#if DEBUG - if verboseOptimizations then dprintf "val %s gets opt info %s\n" (showL(valL v)) (showL(exprValueInfoL cenv.g einfo.Info)); -#endif + errorR(InternalError("the mustinline value '"+v.LogicalName+"' was not inferred to have a known value",v.Range)) let env = BindInternalLocalVal cenv v (mkValInfo einfo v) env (TBind(v,repr',spBind), einfo), env with exn -> - errorRecovery exn v.Range; + errorRecovery exn v.Range raise (ReportedError (Some exn)) and OptimizeBindings cenv isRec env xs = FlatList.mapFold (OptimizeBinding cenv isRec) env xs @@ -3102,7 +3052,7 @@ and OptimizeModuleExpr cenv env x = // Check the thing is not compiled as a static field or property, since reflected definitions and other reflective stuff might need it not (IsCompiledAsStaticProperty cenv.g bind.Var)) - if verboseOptimizations then dead |> List.iter (fun (bind,_) -> dprintf "dead, hidden, buried, gone: %s\n" (showL (vspecAtBindL bind.Var))); + let deadSet = Zset.addList (dead |> List.map (fun (bind,_) -> bind.Var)) (Zset.empty valOrder) // Eliminate dead private bindings from a module type by mutation. Note that the optimizer doesn't @@ -3120,7 +3070,7 @@ and OptimizeModuleExpr cenv env x = vals= (mtyp.AllValsAndMembers |> QueueList.filter (Zset.memberOf deadSet >> not)), entities= mtyp.AllEntities) mtyp.ModuleAndNamespaceDefinitions |> List.iter (fun mspec -> elimModSpec mspec) - mty; + mty and elimModSpec (mspec:ModuleOrNamespace) = let mtyp = elimModTy mspec.ModuleOrNamespaceType mspec.Data.entity_modul_contents <- notlazy mtyp @@ -3167,7 +3117,7 @@ and OptimizeModuleDef cenv (env,bindInfosColl) x = (* REVIEW: Eliminate let bindings on the way back up *) (TMDefRec(isRec,tycons,mbinds,m), - notlazy { ValInfos= ValInfos(FlatList.map2 (fun bind binfo -> mkValBind bind (mkValInfo binfo bind.Var)) binds binfos); + notlazy { ValInfos= ValInfos(FlatList.map2 (fun bind binfo -> mkValBind bind (mkValInfo binfo bind.Var)) binds binfos) ModuleOrNamespaceInfos = NameMap.ofList minfos}), (env,bindInfosColl) | TMAbstract(mexpr) -> @@ -3178,7 +3128,7 @@ and OptimizeModuleDef cenv (env,bindInfosColl) x = let ((bind',binfo) as bindInfo),env = OptimizeBinding cenv false env bind (* REVIEW: Eliminate unused let bindings from modules *) (TMDefLet(bind',m), - notlazy { ValInfos=ValInfos [mkValBind bind (mkValInfo binfo bind.Var)]; + notlazy { ValInfos=ValInfos [mkValBind bind (mkValInfo binfo bind.Var)] ModuleOrNamespaceInfos = NameMap.ofList []}), (env ,([bindInfo]::bindInfosColl)) @@ -3205,7 +3155,6 @@ and OptimizeModuleBinding cenv (env,bindInfosColl) x = (env,bindInfosColl) and OptimizeModuleDefs cenv (env,bindInfosColl) defs = - if verboseOptimizations then dprintf "OptimizeModuleDefs\n"; let defs,(env,bindInfosColl) = List.mapFold (OptimizeModuleDef cenv) (env,bindInfosColl) defs let defs,minfos = List.unzip defs (defs,UnionOptimizationInfos minfos),(env,bindInfosColl) @@ -3237,14 +3186,14 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qn let OptimizeImplFile(settings,ccu,tcGlobals,tcVal, importMap,optEnv,isIncrementalFragment,emitTailcalls,hidden,mimpls) = let cenv = - { settings=settings; - scope=ccu; + { settings=settings + scope=ccu TcVal = tcVal - g=tcGlobals; - amap=importMap; - optimizing=true; - localInternalVals=new System.Collections.Generic.Dictionary(10000); - emitTailcalls=emitTailcalls; + g=tcGlobals + amap=importMap + optimizing=true + localInternalVals=new System.Collections.Generic.Dictionary(10000) + emitTailcalls=emitTailcalls casApplied=new Dictionary() } OptimizeImplFileInternal cenv optEnv isIncrementalFragment hidden mimpls diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 0dae5cdfbf2..55632d51a68 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -310,7 +310,7 @@ let ShowCounterExample g denv m refuted = match refutations with | [] -> raise CannotRefute | h :: t -> - if verbose then dprintf "h = %s\n" (Layout.showL (exprL h)); + if verbose then dprintf "h = %s\n" (Layout.showL (exprL h)) List.fold (CombineRefutations g) h t let text = Layout.showL (NicePrint.dataExprL denv counterExample) let failingWhenClause = refuted |> List.exists (function RefutedWhenClause -> true | _ -> false) @@ -320,7 +320,7 @@ let ShowCounterExample g denv m refuted = | CannotRefute -> None | e -> - warning(InternalError(sprintf "" (e.ToString()),m)); + warning(InternalError(sprintf "" (e.ToString()),m)) None //--------------------------------------------------------------------------- @@ -375,7 +375,7 @@ let getDiscrimOfPattern g tpinst t = | TPat_array (args,ty,_m) -> Some(Test.ArrayLength (args.Length,ty)) | TPat_query ((pexp,resTys,apatVrefOpt,idx,apinfo),_,_m) -> - Some(Test.ActivePatternCase (pexp, instTypes tpinst resTys, apatVrefOpt,idx,apinfo)) + Some(Test.ActivePatternCase (pexp, instTypes tpinst resTys, apatVrefOpt, idx, apinfo)) | _ -> None let constOfDiscrim discrim = @@ -493,8 +493,8 @@ let (|ListEmptyDiscrim|_|) g = function /// - Compact integer switches become a single switch. Non-compact integer /// switches, string switches and floating point switches are treated in the /// same way as Test.IsInst. -let rec BuildSwitch resPreBindOpt g expr edges dflt m = - if verbose then dprintf "--> BuildSwitch@%a, #edges = %A, dflt.IsSome = %A\n" outputRange m (List.length edges) (Option.isSome dflt); +let rec BuildSwitch inpExprOpt g expr edges dflt m = + if verbose then dprintf "--> BuildSwitch@%a, #edges = %A, dflt.IsSome = %A\n" outputRange m (List.length edges) (Option.isSome dflt) match edges,dflt with | [], None -> failwith "internal error: no edges and no default" | [], Some dflt -> dflt (* NOTE: first time around, edges<>[] *) @@ -505,12 +505,12 @@ let rec BuildSwitch resPreBindOpt g expr edges dflt m = // 'isinst' tests where we have stored the result of the 'isinst' in a variable // In this case the 'expr' already holds the result of the 'isinst' test. - | (TCase(Test.IsInst _,success)):: edges, dflt when isSome resPreBindOpt -> + | (TCase(Test.IsInst _,success)):: edges, dflt when isSome inpExprOpt -> TDSwitch(expr,[TCase(Test.IsNull,BuildSwitch None g expr edges dflt m)],Some success,m) // isnull and isinst tests | (TCase((Test.IsNull | Test.IsInst _),_) as edge):: edges, dflt -> - TDSwitch(expr,[edge],Some (BuildSwitch resPreBindOpt g expr edges dflt m),m) + TDSwitch(expr,[edge],Some (BuildSwitch inpExprOpt g expr edges dflt m),m) #if OPTIMIZE_LIST_MATCHING // 'cons/nil' tests where we have stored the result of the cons test in an 'isinst' in a variable @@ -519,7 +519,7 @@ let rec BuildSwitch resPreBindOpt g expr edges dflt m = | [TCase(ListEmptyDiscrim g tinst, emptyCase)], Some consCase | [TCase(ListEmptyDiscrim g _, emptyCase); TCase(ListConsDiscrim g tinst, consCase)], None | [TCase(ListConsDiscrim g tinst, consCase); TCase(ListEmptyDiscrim g _, emptyCase)], None - when isSome resPreBindOpt -> + when isSome inpExprOpt -> TDSwitch(expr, [TCase(Test.IsNull, emptyCase)], Some consCase, m) #endif @@ -562,7 +562,6 @@ let rec BuildSwitch resPreBindOpt g expr edges dflt m = | _ -> failwith "illtyped term during pattern compilation" let edges' = List.sortWith edgeCompare edges let rec compactify curr edges = - if debug then dprintf "--> compactify@%a\n" outputRange m; match curr,edges with | None,[] -> [] | Some last,[] -> [List.rev last] @@ -592,7 +591,7 @@ let rec BuildSwitch resPreBindOpt g expr edges dflt m = // For a total pattern match, run the active pattern, bind the result and // recursively build a switch in the choice type | (TCase(Test.ActivePatternCase _,_)::_), _ -> - error(InternalError("Test.ActivePatternCase should have been eliminated",m)); + error(InternalError("Test.ActivePatternCase should have been eliminated",m)) // For a complete match, optimize one test to be the default | (TCase(_,tree)::rest), None -> TDSwitch (expr,rest,Some tree,m) @@ -602,7 +601,6 @@ let rec BuildSwitch resPreBindOpt g expr edges dflt m = #if DEBUG let rec layoutPat pat = - if debug then dprintf "--> layoutPat\n"; match pat with | TPat_query (_,pat,_) -> Layout.(--) (Layout.wordL "query") (layoutPat pat) | TPat_wild _ -> Layout.wordL "wild" @@ -696,9 +694,9 @@ let CompilePatternBasic if warnOnIncomplete then match actionOnFailure with | ThrowIncompleteMatchException -> - warning (MatchIncomplete (false,ShowCounterExample g denv matchm refuted, matchm)); + warning (MatchIncomplete (false,ShowCounterExample g denv matchm refuted, matchm)) | IgnoreWithWarning -> - warning (MatchIncomplete (true,ShowCounterExample g denv matchm refuted, matchm)); + warning (MatchIncomplete (true,ShowCounterExample g denv matchm refuted, matchm)) | _ -> () @@ -722,8 +720,8 @@ let CompilePatternBasic | ThrowIncompleteMatchException -> mkThrow matchm resultTy (mkExnExpr(mk_MFCore_tcref g.fslibCcu "MatchFailureException", - [ mkString g matchm matchm.FileName; - mkInt g matchm matchm.StartLine; + [ mkString g matchm matchm.FileName + mkInt g matchm matchm.StartLine mkInt g matchm matchm.StartColumn],matchm)) | IgnoreWithWarning -> @@ -737,9 +735,9 @@ let CompilePatternBasic // will run the handler and hit the sequence point there. // That sequence point will have the pattern variables bound, which is exactly what we want. let tg = TTarget(FlatList.empty,throwExpr,SuppressSequencePointAtTarget ) - mbuilder.AddTarget tg |> ignore; + mbuilder.AddTarget tg |> ignore let clause = TClause(TPat_wild matchm,None,tg,matchm) - incompleteMatchClauseOnce := Some(clause); + incompleteMatchClauseOnce := Some(clause) clause | Some c -> c @@ -769,7 +767,6 @@ let CompilePatternBasic // The main recursive loop of the pattern match compiler let rec InvestigateFrontiers refuted frontiers = - if debug then dprintf "frontiers = %s\n" (String.concat ";" (List.map (getRuleIndex >> string) frontiers)); match frontiers with | [] -> failwith "CompilePattern:compile - empty clauses: at least the final clause should always succeed" | (Frontier (i,active,valMap)) :: rest -> @@ -779,7 +776,6 @@ let CompilePatternBasic | [] -> CompileSuccessPointAndGuard i refuted valMap rest | _ -> - if debug then dprintf "Investigating based on rule %d, #active = %d\n" i (List.length active); (* Otherwise choose a point (i.e. a path) to investigate. *) let (Active(path,subexpr,pat)) = ChooseInvestigationPointLeftToRight frontiers match pat with @@ -789,21 +785,14 @@ let CompilePatternBasic // Leaving the ones where we have real work to do | _ -> - if debug then dprintf "chooseSimultaneousEdgeSet\n"; let simulSetOfEdgeDiscrims,fallthroughPathFrontiers = ChooseSimultaneousEdges frontiers path - let resPreBindOpt, bindOpt = ChoosePreBinder simulSetOfEdgeDiscrims subexpr + let inpExprOpt, bindOpt = ChoosePreBinder simulSetOfEdgeDiscrims subexpr // For each case, recursively compile the residue decision trees that result if that case successfully matches - let simulSetOfCases, _ = CompileSimultaneousSet frontiers path refuted subexpr simulSetOfEdgeDiscrims resPreBindOpt + let simulSetOfCases, _ = CompileSimultaneousSet frontiers path refuted subexpr simulSetOfEdgeDiscrims inpExprOpt - assert (nonNil(simulSetOfCases)); - - if debug then - dprintf "#fallthroughPathFrontiers = %d, #simulSetOfEdgeDiscrims = %d\n" (List.length fallthroughPathFrontiers) (List.length simulSetOfEdgeDiscrims); - dprintf "Making cases for each discriminator...\n"; - dprintf "#edges = %d\n" (List.length simulSetOfCases); - dprintf "Checking for completeness of edge set from earlier investigation of rule %d, #active = %d\n" i (List.length active); + assert (nonNil(simulSetOfCases)) // Work out what the default/fall-through tree looks like, is any // Check if match is complete, if so optimize the default case away. @@ -812,8 +801,8 @@ let CompilePatternBasic // OK, build the whole tree and whack on the binding if any let finalDecisionTree = - let inpExprToSwitch = (match resPreBindOpt with Some vexp -> vexp | None -> GetSubExprOfInput subexpr) - let tree = BuildSwitch resPreBindOpt g inpExprToSwitch simulSetOfCases defaultTreeOpt matchm + let inpExprToSwitch = (match inpExprOpt with Some vexp -> vexp | None -> GetSubExprOfInput subexpr) + let tree = BuildSwitch inpExprOpt g inpExprToSwitch simulSetOfCases defaultTreeOpt matchm match bindOpt with | None -> tree | Some bind -> TDBind (bind,tree) @@ -822,7 +811,6 @@ let CompilePatternBasic and CompileSuccessPointAndGuard i refuted valMap rest = - if debug then dprintf "generating success node for rule %d\n" i; let vs2 = GetValsBoundByClause i refuted let es2 = vs2 |> FlatList.map (fun v -> @@ -832,7 +820,6 @@ let CompilePatternBasic let rhs' = TDSuccess(es2, i) match GetWhenGuardOfClause i refuted with | Some whenExpr -> - if debug then dprintf "generating success node for rule %d, with 'when' clause\n" i; let m = whenExpr.Range @@ -856,16 +843,14 @@ let CompilePatternBasic /// Record the rule numbers so we know which rule the TPat_query cam from, so that when we project through /// the frontier we only project the right rule. and ChooseSimultaneousEdges frontiers path = - if debug then dprintf "chooseSimultaneousEdgeSet\n"; frontiers |> chooseSimultaneousEdgeSet None (fun prevOpt (Frontier (i',active',_)) -> if isMemOfActives path active' then let p = lookupActive path active' |> snd match getDiscrimOfPattern p with | Some discrim -> - if (match prevOpt with None -> true | Some (EdgeDiscrim(_,discrimPrev,_)) -> discrimsHaveSameSimultaneousClass g discrim discrimPrev) then ( - if debug then dprintf "taking rule %d\n" i'; + if (match prevOpt with None -> true | Some (EdgeDiscrim(_,discrimPrev,_)) -> discrimsHaveSameSimultaneousClass g discrim discrimPrev) then Some (EdgeDiscrim(i',discrim,p.Range)),true - ) else + else None,false | None -> @@ -892,11 +877,26 @@ let CompilePatternBasic let v,vexp = mkCompGenLocal m "typeTestResult" tgty if topv.IsMemberOrModuleBinding then - AdjustValToTopVal v topv.ActualParent ValReprInfo.emptyValData; + AdjustValToTopVal v topv.ActualParent ValReprInfo.emptyValData let argexp = GetSubExprOfInput subexpr let appexp = mkIsInst tgty argexp matchm Some(vexp),Some(mkInvisibleBind v appexp) + // Any match on a struct union must take the address of its input + | EdgeDiscrim(_i',(Test.UnionCase (ucref, _)),_) :: _rest + when (isNil topgtvs && ucref.Tycon.IsStructRecordOrUnionTycon) -> + + let argexp = GetSubExprOfInput subexpr + let vOpt,addrexp = mkExprAddrOfExprAux g true false NeverMutates argexp None matchm + match vOpt with + | None -> Some addrexp, None + | Some (v,e) -> + if topv.IsMemberOrModuleBinding then + AdjustValToTopVal v topv.ActualParent ValReprInfo.emptyValData + Some addrexp, Some (mkInvisibleBind v e) + + + #if OPTIMIZE_LIST_MATCHING | [EdgeDiscrim(_, ListConsDiscrim g tinst,m); EdgeDiscrim(_, ListEmptyDiscrim g _, _)] | [EdgeDiscrim(_, ListEmptyDiscrim g _, _); EdgeDiscrim(_, ListConsDiscrim g tinst, m)] @@ -908,21 +908,20 @@ let CompilePatternBasic let ucaseTy = (mkProvenUnionCaseTy g.cons_ucref tinst) let v,vexp = mkCompGenLocal m "unionTestResult" ucaseTy if topv.IsMemberOrModuleBinding then - AdjustValToTopVal v topv.ActualParent ValReprInfo.emptyValData; + AdjustValToTopVal v topv.ActualParent ValReprInfo.emptyValData let argexp = GetSubExprOfInput subexpr let appexp = mkIsInst ucaseTy argexp matchm Some vexp,Some (mkInvisibleBind v appexp) #endif // Active pattern matches: create a variable to hold the results of executing the active pattern. - | (EdgeDiscrim(_,(Test.ActivePatternCase(pexp,resTys,_resPreBindOpt,_,apinfo)),m) :: _) -> - if debug then dprintf "Building result var for active pattern...\n"; + | (EdgeDiscrim(_,(Test.ActivePatternCase(pexp,resTys,_,_,apinfo)),m) :: _) -> - if nonNil topgtvs then error(InternalError("Unexpected generalized type variables when compiling an active pattern",m)); + if nonNil topgtvs then error(InternalError("Unexpected generalized type variables when compiling an active pattern",m)) let rty = apinfo.ResultType g m resTys let v,vexp = mkCompGenLocal m "activePatternResult" rty if topv.IsMemberOrModuleBinding then - AdjustValToTopVal v topv.ActualParent ValReprInfo.emptyValData; + AdjustValToTopVal v topv.ActualParent ValReprInfo.emptyValData let argexp = GetSubExprOfInput subexpr let appexp = mkApps g ((pexp,tyOfExpr g pexp), [], [argexp],m) @@ -930,7 +929,7 @@ let CompilePatternBasic | _ -> None,None - and CompileSimultaneousSet frontiers path refuted subexpr simulSetOfEdgeDiscrims (resPreBindOpt: Expr option) = + and CompileSimultaneousSet frontiers path refuted subexpr simulSetOfEdgeDiscrims (inpExprOpt: Expr option) = ([],simulSetOfEdgeDiscrims) ||> List.collectFold (fun taken (EdgeDiscrim(i',discrim,m)) -> // Check to see if we've already collected the edge for this case, in which case skip it. @@ -953,17 +952,18 @@ let CompilePatternBasic match discrim with | Test.UnionCase (ucref, tinst) when #if OPTIMIZE_LIST_MATCHING - isNone resPreBindOpt && + isNone inpExprOpt && #endif (isNil topgtvs && not topv.IsMemberOrModuleBinding && + not ucref.Tycon.IsStructRecordOrUnionTycon && ucref.UnionCase.RecdFields.Length >= 1 && ucref.Tycon.UnionCasesArray.Length > 1) -> let v,vexp = mkCompGenLocal m "unionCase" (mkProvenUnionCaseTy ucref tinst) let argexp = GetSubExprOfInput subexpr - let appexp = mkUnionCaseProof(argexp, ucref,tinst,m) - Some(vexp),Some(mkInvisibleBind v appexp) + let appexp = mkUnionCaseProof (argexp, ucref,tinst,m) + Some vexp,Some(mkInvisibleBind v appexp) | _ -> None,None @@ -974,7 +974,7 @@ let CompilePatternBasic let aparity = apinfo.Names.Length let total = apinfo.IsTotal if not total && aparity > 1 then - error(Error(FSComp.SR.patcPartialActivePatternsGenerateOneResult(),m)); + error(Error(FSComp.SR.patcPartialActivePatternsGenerateOneResult(),m)) if not total then Test.UnionCase(mkSomeCase g,resTys) elif aparity <= 1 then Test.Const(Const.Unit) @@ -984,7 +984,7 @@ let CompilePatternBasic // Project a successful edge through the frontiers. let investigation = Investigation(i',discrim,path) - let frontiers = frontiers |> List.collect (GenerateNewFrontiersAfterSucccessfulInvestigation resPreBindOpt resPostBindOpt investigation) + let frontiers = frontiers |> List.collect (GenerateNewFrontiersAfterSucccessfulInvestigation inpExprOpt resPostBindOpt investigation) let tree = InvestigateFrontiers refuted frontiers // Bind the resVar for the union case, if we have one let tree = @@ -1017,7 +1017,6 @@ let CompilePatternBasic (* Add to the refuted set *) let refuted = (RefutedInvestigation(path,simulSetOfDiscrims)) :: refuted - if debug then dprintf "Edge set was incomplete. Compiling remaining cases\n"; match fallthroughPathFrontiers with | [] -> None @@ -1026,12 +1025,10 @@ let CompilePatternBasic // Build a new frontier that represents the result of a successful investigation // at rule point (i',discrim,path) - and GenerateNewFrontiersAfterSucccessfulInvestigation resPreBindOpt resPostBindOpt (Investigation(i',discrim,path)) (Frontier (i, active,valMap) as frontier) = - if debug then dprintf "projecting success of investigation encompassing rule %d through rule %d \n" i' i; + and GenerateNewFrontiersAfterSucccessfulInvestigation inpExprOpt resPostBindOpt (Investigation(i',discrim,path)) (Frontier (i, active,valMap) as frontier) = if (isMemOfActives path active) then let (SubExpr(accessf,ve)),pat = lookupActive path active - if debug then dprintf "active...\n"; let mkSubFrontiers path accessf' active' argpats pathBuilder = let mkSubActive j p = @@ -1052,11 +1049,14 @@ let CompilePatternBasic if (hasParam && i = i') || (discrimsEq g discrim (Option.get (getDiscrimOfPattern pat))) then let aparity = apinfo.Names.Length let accessf' j tpinst _e' = + assert inpExprOpt.IsSome if aparity <= 1 then - Option.get resPreBindOpt + Option.get inpExprOpt else let ucref = mkChoiceCaseRef g m aparity idx - mkUnionCaseFieldGetUnproven(Option.get resPreBindOpt,ucref,instTypes tpinst resTys,j,exprm) + // TODO: In the future we will want active patterns to be able to return struct-unions + // In that eventuality, we need to check we are taking the address correctly + mkUnionCaseFieldGetUnprovenViaExprAddr (Option.get inpExprOpt,ucref,instTypes tpinst resTys,j,exprm) mkSubFrontiers path accessf' active' [p] (fun path j -> PathQuery(path,int64 j)) elif hasParam then @@ -1068,7 +1068,9 @@ let CompilePatternBasic else if i = i' then let accessf' _j tpinst _ = - mkUnionCaseFieldGetUnproven(Option.get resPreBindOpt, mkSomeCase g, instTypes tpinst resTys, 0, exprm) + // TODO: In the future we will want active patterns to be able to return struct-unions + // In that eventuality, we need to check we are taking the address correctly + mkUnionCaseFieldGetUnprovenViaExprAddr (Option.get inpExprOpt, mkSomeCase g, instTypes tpinst resTys, 0, exprm) mkSubFrontiers path accessf' active' [p] (fun path j -> PathQuery(path,int64 j)) else // Successful active patterns don't refute other patterns @@ -1077,15 +1079,15 @@ let CompilePatternBasic | TPat_unioncase (ucref1, tyargs, argpats,_) -> match discrim with | Test.UnionCase (ucref2, tinst) when g.unionCaseRefEq ucref1 ucref2 -> - let accessf' j tpinst e' = -#if OPTIMIZE_LIST_MATCHING - match resPreBindOpt with - | Some e -> mkUnionCaseFieldGetProven(e,ucref1,tinst,j,exprm) - | None -> -#endif + let accessf' j tpinst exprIn = match resPostBindOpt with - | Some e -> mkUnionCaseFieldGetProven(e,ucref1,tinst,j,exprm) - | None -> mkUnionCaseFieldGetUnproven(accessf tpinst e',ucref1,instTypes tpinst tyargs,j,exprm) + | Some e -> mkUnionCaseFieldGetProvenViaExprAddr (e,ucref1,tinst,j,exprm) + | None -> + let exprIn = + match inpExprOpt with + | Some addrexp -> addrexp + | None -> accessf tpinst exprIn + mkUnionCaseFieldGetUnprovenViaExprAddr (exprIn,ucref1,instTypes tpinst tyargs,j,exprm) mkSubFrontiers path accessf' active' argpats (fun path j -> PathUnionConstr(path,ucref1,tyargs,j)) | Test.UnionCase _ -> @@ -1098,7 +1100,7 @@ let CompilePatternBasic | TPat_array (argpats,ty,_) -> match discrim with | Test.ArrayLength (n,_) when List.length argpats = n -> - let accessf' j tpinst e' = mkCallArrayGet g exprm ty (accessf tpinst e') (mkInt g exprm j) + let accessf' j tpinst exprIn = mkCallArrayGet g exprm ty (accessf tpinst exprIn) (mkInt g exprm j) mkSubFrontiers path accessf' active' argpats (fun path j -> PathArray(path,ty,List.length argpats,j)) // Successful length tests refute all other lengths | Test.ArrayLength _ -> @@ -1109,7 +1111,7 @@ let CompilePatternBasic | TPat_exnconstr (ecref, argpats,_) -> match discrim with | Test.IsInst (_srcTy,tgtTy) when typeEquiv g (mkAppTy ecref []) tgtTy -> - let accessf' j tpinst e' = mkExnCaseFieldGet(accessf tpinst e',ecref,j,exprm) + let accessf' j tpinst exprIn = mkExnCaseFieldGet(accessf tpinst exprIn,ecref,j,exprm) mkSubFrontiers path accessf' active' argpats (fun path j -> PathExnConstr(path,ecref,j)) | _ -> // Successful type tests against one sealed type refute all other sealed types @@ -1121,16 +1123,16 @@ let CompilePatternBasic | Test.IsInst (_srcTy,tgtTy2) when typeEquiv g tgtTy1 tgtTy2 -> match pbindOpt with | Some pbind -> - let accessf' tpinst e' = + let accessf' tpinst exprIn = // Fetch the result from the place where we saved it, if possible - match resPreBindOpt with + match inpExprOpt with | Some e -> e | _ -> // Otherwise call the helper - mkCallUnboxFast g exprm (instType tpinst tgtTy1) (accessf tpinst e') + mkCallUnboxFast g exprm (instType tpinst tgtTy1) (accessf tpinst exprIn) - let (v,e') = BindSubExprOfInput g amap topgtvs pbind exprm (SubExpr(accessf',ve)) - [Frontier (i, active', valMap.Add v e' )] + let (v,exprIn) = BindSubExprOfInput g amap topgtvs pbind exprm (SubExpr(accessf',ve)) + [Frontier (i, active', valMap.Add v exprIn )] | None -> [Frontier (i, active', valMap)] @@ -1169,17 +1171,17 @@ let CompilePatternBasic | TPat_wild _ -> BindProjectionPatterns [] s | TPat_as(p',pbind,m) -> - let (v,e') = BindSubExprOfInput g amap topgtvs pbind m subExpr - BindProjectionPattern (Active(path,subExpr,p')) (accActive,accValMap.Add v e' ) + let (v,subExpr') = BindSubExprOfInput g amap topgtvs pbind m subExpr + BindProjectionPattern (Active(path,subExpr,p')) (accActive,accValMap.Add v subExpr' ) | TPat_tuple(ps,tyargs,_m) -> - let accessf' j tpinst e' = mkTupleFieldGet(accessf tpinst e',instTypes tpinst tyargs,j,exprm) + let accessf' j tpinst exprIn = mkTupleFieldGet(accessf tpinst exprIn,instTypes tpinst tyargs,j,exprm) let pathBuilder path j = PathTuple(path,tyargs,j) let newActives = List.mapi (mkSubActive pathBuilder accessf') ps BindProjectionPatterns newActives s | TPat_recd(tcref,tinst,ps,_m) -> let newActives = (ps,tcref.TrueInstanceFieldsAsRefList) ||> List.mapi2 (fun j p fref -> - let accessf' fref _j tpinst e' = mkRecdFieldGet g (accessf tpinst e',fref,instTypes tpinst tinst,exprm) + let accessf' fref _j tpinst exprIn = mkRecdFieldGet g (accessf tpinst exprIn,fref,instTypes tpinst tinst,exprm) let pathBuilder path j = PathRecd(path,tcref,tinst,j) mkSubActive pathBuilder (accessf' fref) j p) BindProjectionPatterns newActives s @@ -1252,7 +1254,6 @@ let rec CompilePattern g denv amap exprm matchm warnOnUnused actionOnFailure (t let warnOnIncomplete = false let rec atMostOnePartialAtATime clauses = - if debug then dprintf "atMostOnePartialAtATime: #clauses = %A\n" clauses; match List.takeUntil isPartialOrWhenClause clauses with | l,[] -> CompilePatternBasic g denv amap exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (topv,topgtvs) l inputTy resultTy @@ -1261,7 +1262,6 @@ let rec CompilePattern g denv amap exprm matchm warnOnUnused actionOnFailure (t doGroupWithAtMostOnePartial (l @ [h]) t and doGroupWithAtMostOnePartial group rest = - if debug then dprintf "doGroupWithAtMostOnePartial: #group = %A\n" group; // Compile the remaining clauses let dtree,targets = atMostOnePartialAtATime rest diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index d9ea90e1715..8b5987bb899 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -133,11 +133,11 @@ type env = { boundTyparNames: string list boundTypars: TyparMap /// "module remap info", i.e. hiding information down the signature chain, used to compute what's hidden by a signature - sigToImplRemapInfo: (Remap * SignatureHidingInfo) list; + sigToImplRemapInfo: (Remap * SignatureHidingInfo) list /// Constructor limited - are we in the prelude of a constructor, prior to object initialization - limited: bool; + limited: bool /// Are we in a quotation? - quote : bool; + quote : bool /// Are we under []? reflect : bool } @@ -153,21 +153,21 @@ let BindTypars g env (tps:Typar list) = let nms = PrettyTypes.PrettyTyparNames (fun _ -> true) env.boundTyparNames tps (tps,nms) ||> List.iter2 (fun tp nm -> if PrettyTypes.NeedsPrettyTyparName tp then - tp.Data.typar_id <- ident (nm,tp.Range)); + tp.Data.typar_id <- ident (nm,tp.Range)) List.fold BindTypar env tps type cenv = - { boundVals: Dictionary; // really a hash set - mutable potentialUnboundUsesOfVals: StampMap; - g: TcGlobals; - amap: Import.ImportMap; + { boundVals: Dictionary // really a hash set + mutable potentialUnboundUsesOfVals: StampMap + g: TcGlobals + amap: Import.ImportMap /// For reading metadata - infoReader: InfoReader; - internalsVisibleToPaths : CompilationPath list; - denv: DisplayEnv; - viewCcu : CcuThunk; - reportErrors: bool; - isLastCompiland : bool*bool; + infoReader: InfoReader + internalsVisibleToPaths : CompilationPath list + denv: DisplayEnv + viewCcu : CcuThunk + reportErrors: bool + isLastCompiland : bool*bool // outputs mutable usesQuotations : bool mutable entryPointGiven:bool } @@ -220,7 +220,7 @@ let rec CheckTypeDeep ((visitTyp,visitTyconRefOpt,visitByrefsOfByrefsOpt,visitTr match typ with | TType_forall (tps,body) -> let env = BindTypars g env tps - CheckTypeDeep f g env body; + CheckTypeDeep f g env body tps |> List.iter (fun tp -> tp.Constraints |> List.iter (CheckTypeConstraintDeep f g env)) | TType_measure _ -> () @@ -261,9 +261,9 @@ and CheckTypeConstraintDeep f g env x = | TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _ -> () and CheckTraitInfoDeep ((_,_,_,visitTraitSolutionOpt,_) as f) g env (TTrait(typs,_,_,argtys,rty,soln)) = - CheckTypesDeep f g env typs; - CheckTypesDeep f g env argtys; - Option.iter (CheckTypeDeep f g env) rty; + CheckTypesDeep f g env typs + CheckTypesDeep f g env argtys + Option.iter (CheckTypeDeep f g env) rty match visitTraitSolutionOpt, !soln with | Some visitTraitSolution, Some sln -> visitTraitSolution sln | _ -> () @@ -465,29 +465,30 @@ let rec CheckExpr (cenv:cenv) (env:env) expr = and CheckVal (cenv:cenv) (env:env) v m context = if cenv.reportErrors then - if is_splice cenv.g v && not env.quote then errorR(Error(FSComp.SR.chkSplicingOnlyInQuotations(), m)); - if is_splice 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 is_splice cenv.g v && not env.quote then errorR(Error(FSComp.SR.chkSplicingOnlyInQuotations(), m)) + if is_splice 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 isByrefLikeTy cenv.g v.Type then // byref typed val can only occur in permitting contexts if context <> DirectArg then errorR(Error(FSComp.SR.chkNoByrefAtThisPoint(v.DisplayName), m)) CheckTypePermitByrefs cenv env m v.Type and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) = - // dprintf "CheckExpr: %s\n" (showL(exprL expr)); let expr = stripExpr expr match expr with | Expr.Sequential (e1,e2,dir,_,_) -> - CheckExpr cenv env e1; + CheckExpr cenv env e1 match dir with | NormalSeq -> CheckExprInContext cenv env e2 context // carry context into _;RHS (normal sequencing only) | ThenDoSeq -> CheckExpr cenv {env with limited=false} e2 + | Expr.Let (bind,body,_,_) -> - CheckBinding cenv env false bind ; + CheckBinding cenv env false bind BindVal cenv bind.Var - CheckExpr cenv env body + CheckExprInContext cenv env body context + | Expr.Const (_,m,ty) -> CheckTypePermitByrefs cenv env m ty @@ -498,12 +499,12 @@ and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) = if (match vFlags with NormalValUse -> true | _ -> false) && v.IsConstructor && (match v.ActualParent with Parent tcref -> isAbstractTycon tcref.Deref | _ -> false) then - errorR(Error(FSComp.SR.tcAbstractTypeCannotBeInstantiated(),m)); + errorR(Error(FSComp.SR.tcAbstractTypeCannotBeInstantiated(),m)) CheckVal cenv env v m context | Expr.Quote(ast,savedConv,_isFromQueryExpression,m,ty) -> - CheckExpr cenv {env with quote=true} ast; + CheckExpr cenv {env with quote=true} ast if cenv.reportErrors then cenv.usesQuotations <- true try @@ -519,9 +520,9 @@ and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) = CheckTypeNoByrefs cenv env m ty | Expr.Obj (_,typ,basev,superInitCall,overrides,iimpls,m) -> - CheckExpr cenv env superInitCall; - CheckMethods cenv env basev overrides ; - CheckInterfaceImpls cenv env basev iimpls; + CheckExpr cenv env superInitCall + CheckMethods cenv env basev overrides + CheckInterfaceImpls cenv env basev iimpls CheckTypePermitByrefs cenv env m typ let interfaces = [ if isInterfaceTy cenv.g typ then @@ -538,12 +539,12 @@ and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) = // dprintfn "GOT BASE VAL USE" let memberInfo = Option.get v.MemberInfo if memberInfo.MemberFlags.IsDispatchSlot then - errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(v.DisplayName),m)); + errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(v.DisplayName),m)) else CheckVal cenv env v m GeneralContext CheckVal cenv env baseVal m GeneralContext - CheckTypePermitByrefs cenv env m fty; - CheckTypeInstPermitByrefs cenv env m tyargs; + CheckTypePermitByrefs cenv env m fty + CheckTypeInstPermitByrefs cenv env m tyargs CheckExprsInContext cenv env rest (argAritiesOfFunExpr f) // Allow base calls to IL methods @@ -560,13 +561,13 @@ and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) = // equality. It would be better to make this check in tc.fs when we have the Abstract IL metadata for the method to hand. let mdef = resolveILMethodRef tcref.ILTyconRawMetadata mref if mdef.IsAbstract then - errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(mdef.Name),m)); + errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(mdef.Name),m)) with _ -> () // defensive coding | _ -> () - CheckTypeInstNoByrefs cenv env m tyargs; - CheckTypeInstNoByrefs cenv env m enclTypeArgs; - CheckTypeInstNoByrefs cenv env m methTypeArgs; - CheckTypeInstNoByrefs cenv env m tys; + CheckTypeInstNoByrefs cenv env m tyargs + CheckTypeInstNoByrefs cenv env m enclTypeArgs + CheckTypeInstNoByrefs cenv env m methTypeArgs + CheckTypeInstNoByrefs cenv env m tys CheckVal cenv env baseVal m GeneralContext CheckExprDirectArgs cenv env rest @@ -582,7 +583,7 @@ and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) = // Allow '%expr' in quotations | Expr.App(Expr.Val(vref,_,_),_,tinst,[arg],m) when is_splice cenv.g vref && env.quote -> - CheckTypeInstPermitByrefs cenv env m tinst; + CheckTypeInstPermitByrefs cenv env m tinst CheckExpr cenv env arg @@ -619,10 +620,10 @@ and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) = | _ -> () - CheckTypeInstNoByrefs cenv env m tyargs; - CheckTypePermitByrefs cenv env m fty; - CheckTypeInstPermitByrefs cenv env m tyargs; - CheckExpr cenv env f; + CheckTypeInstNoByrefs cenv env m tyargs + CheckTypePermitByrefs cenv env m fty + CheckTypeInstPermitByrefs cenv env m tyargs + CheckExpr cenv env f CheckExprsInContext cenv env argsl (argAritiesOfFunExpr f) (* REVIEW: fold the next two cases together *) @@ -641,19 +642,19 @@ and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) = CheckExpr cenv env e1 | Expr.Match(_,_,dtree,targets,m,ty) -> - CheckTypeNoByrefs cenv env m ty; - CheckDecisionTree cenv env dtree; - CheckDecisionTreeTargets cenv env targets; + CheckTypePermitByrefs cenv env m ty // computed byrefs allowed at each branch + CheckDecisionTree cenv env dtree + CheckDecisionTreeTargets cenv env targets context | Expr.LetRec (binds,e,_,_) -> BindVals cenv (valsOfBinds binds) - CheckBindings cenv env binds; + CheckBindings cenv env binds CheckExpr cenv env e | Expr.StaticOptimization (constraints,e2,e3,m) -> - CheckExpr cenv env e2; - CheckExpr cenv env e3; + CheckExpr cenv env e2 + CheckExpr cenv env e3 constraints |> List.iter (function | TTyconEqualsTycon(ty1,ty2) -> - CheckTypeNoByrefs cenv env m ty1; + CheckTypeNoByrefs cenv env m ty1 CheckTypeNoByrefs cenv env m ty2 | TTyconIsStruct(ty1) -> CheckTypeNoByrefs cenv env m ty1) @@ -666,8 +667,8 @@ and CheckMethods cenv env baseValOpt l = and CheckMethod cenv env baseValOpt (TObjExprMethod(_,attribs,tps,vs,e,m)) = let env = BindTypars cenv.g env tps let vs = List.concat vs - CheckAttribs cenv env attribs; - CheckNoReraise cenv None e; + CheckAttribs cenv env attribs + CheckNoReraise cenv None e CheckEscapes cenv true m (match baseValOpt with Some x -> x:: vs | None -> vs) e |> ignore CheckExpr cenv env e @@ -680,41 +681,41 @@ and CheckInterfaceImpl cenv env baseValOpt (_ty,overrides) = and CheckExprOp cenv env (op,tyargs,args,m) context = let limitedCheck() = - if env.limited then errorR(Error(FSComp.SR.chkObjCtorsCantUseExceptionHandling(), m)); - List.iter (CheckTypePermitByrefs cenv env m) tyargs; + if env.limited then errorR(Error(FSComp.SR.chkObjCtorsCantUseExceptionHandling(), m)) + List.iter (CheckTypePermitByrefs cenv env m) tyargs (* Special cases *) match op,tyargs,args,context with // Handle these as special cases since mutables are allowed inside their bodies | TOp.While _,_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_)],_ -> - CheckTypeInstNoByrefs cenv env m tyargs; + CheckTypeInstNoByrefs cenv env m tyargs CheckExprs cenv env [e1;e2] | TOp.TryFinally _,[_],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)],_ -> - CheckTypeInstNoByrefs cenv env m tyargs; - limitedCheck(); + CheckTypeInstNoByrefs cenv env m tyargs + limitedCheck() CheckExprs cenv env [e1;e2] | TOp.For(_),_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_);Expr.Lambda(_,_,_,[_],e3,_,_)],_ -> - CheckTypeInstNoByrefs cenv env m tyargs; + CheckTypeInstNoByrefs cenv env m tyargs CheckExprs cenv env [e1;e2;e3] | TOp.TryCatch _,[_],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],_e2,_,_); Expr.Lambda(_,_,_,[_],e3,_,_)],_ -> - CheckTypeInstNoByrefs cenv env m tyargs; - limitedCheck(); + CheckTypeInstNoByrefs cenv env m tyargs + limitedCheck() CheckExprs cenv env [e1;(* e2; -- don't check filter body - duplicates logic in 'catch' body *) e3] | TOp.ILCall (_,_,_,_,_,_,_,_,enclTypeArgs,methTypeArgs,tys),_,_,_ -> - CheckTypeInstNoByrefs cenv env m tyargs; - CheckTypeInstNoByrefs cenv env m enclTypeArgs; - CheckTypeInstNoByrefs cenv env m methTypeArgs; - CheckTypeInstNoByrefs cenv env m tys; + CheckTypeInstNoByrefs cenv env m tyargs + CheckTypeInstNoByrefs cenv env m enclTypeArgs + CheckTypeInstNoByrefs cenv env m methTypeArgs + CheckTypeInstNoByrefs cenv env m tys CheckExprDirectArgs cenv env args // Tuple expression in known tuple context | TOp.Tuple,_,_,KnownArityTuple nArity -> if cenv.reportErrors then if args.Length <> nArity then - errorR(InternalError("Tuple arity does not correspond to planned function argument arity",m)); + errorR(InternalError("Tuple arity does not correspond to planned function argument arity",m)) // This tuple should not be generated. The known function arity // means it just bundles arguments. CheckExprDirectArgs cenv env args @@ -726,36 +727,55 @@ and CheckExprOp cenv env (op,tyargs,args,m) context = if cenv.reportErrors then errorR(Error(FSComp.SR.chkNoAddressOfAtThisPoint(v.DisplayName), m)) | TOp.ValFieldGet _rf,_,[arg1],_arity -> - CheckTypeInstNoByrefs cenv env m tyargs; + CheckTypeInstNoByrefs cenv env m tyargs CheckExprDirectArgs cenv env [arg1] (* See mkRecdFieldGetViaExprAddr -- byref arg1 when #args =1 *) (* Property getters on mutable structs come through here. *) | TOp.ValFieldSet _rf,_,[arg1;arg2],_arity -> - CheckTypeInstNoByrefs cenv env m tyargs; - CheckExprDirectArgs cenv env [arg1]; (* See mkRecdFieldSetViaExprAddr -- byref arg1 when #args=2 *) + CheckTypeInstNoByrefs cenv env m tyargs + CheckExprDirectArgs cenv env [arg1] (* See mkRecdFieldSetViaExprAddr -- byref arg1 when #args=2 *) CheckExprs cenv env [arg2] (* Property setters on mutable structs come through here (TBC). *) + | TOp.Coerce,[_ty1;_ty2],[x],_arity -> - CheckTypeInstNoByrefs cenv env m tyargs; + CheckTypeInstNoByrefs cenv env m tyargs CheckExprInContext cenv env x context + | TOp.Reraise,[_ty1],[],_arity -> CheckTypeInstNoByrefs cenv env m tyargs + | TOp.ValFieldGetAddr rfref,tyargs,[],_ -> if context <> DirectArg && cenv.reportErrors then - errorR(Error(FSComp.SR.chkNoAddressStaticFieldAtThisPoint(rfref.FieldName), m)); + errorR(Error(FSComp.SR.chkNoAddressStaticFieldAtThisPoint(rfref.FieldName), m)) CheckTypeInstNoByrefs cenv env m tyargs (* NOTE: there are no arg exprs to check in this case *) + | TOp.ValFieldGetAddr rfref,tyargs,[rx],_ -> if context <> DirectArg && cenv.reportErrors then - errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(rfref.FieldName), m)); + errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(rfref.FieldName), m)) (* This construct is used for &(rx.rfield) and &(rx->rfield). Relax to permit byref types for rx. [See Bug 1263]. *) - CheckTypeInstNoByrefs cenv env m tyargs; + CheckTypeInstNoByrefs cenv env m tyargs CheckExprInContext cenv env rx DirectArg (* allow rx to be byref here *) + + | TOp.UnionCaseFieldGet _,_,[arg1],_arity -> + CheckTypeInstNoByrefs cenv env m tyargs + CheckExprInContext cenv env arg1 DirectArg + + | TOp.UnionCaseTagGet _,_,[arg1],_arity -> + CheckTypeInstNoByrefs cenv env m tyargs + CheckExprInContext cenv env arg1 DirectArg + + | TOp.UnionCaseFieldGetAddr (uref, _idx),tyargs,[rx],_ -> + if context <> DirectArg && cenv.reportErrors then + errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(uref.CaseName), m)) + CheckTypeInstNoByrefs cenv env m tyargs + CheckExprInContext cenv env rx DirectArg // allow rx to be byref here + | TOp.ILAsm (instrs,tys),_,_,_ -> - CheckTypeInstPermitByrefs cenv env m tys; - CheckTypeInstNoByrefs cenv env m tyargs; + CheckTypeInstPermitByrefs cenv env m tys + CheckTypeInstNoByrefs cenv env m tyargs begin match instrs,args with | [ I_stfld (_alignment,_vol,_fspec) ],[lhs;rhs] -> - CheckExprInContext cenv env lhs DirectArg; (* permit byref for lhs lvalue *) + CheckExprInContext cenv env lhs DirectArg (* permit byref for lhs lvalue *) CheckExpr cenv env rhs | [ I_ldfld (_alignment,_vol,_fspec) ],[lhs] -> CheckExprInContext cenv env lhs DirectArg (* permit byref for lhs lvalue *) @@ -763,19 +783,21 @@ and CheckExprOp cenv env (op,tyargs,args,m) context = CheckExprInContext cenv env lhs DirectArg (* permit byref for lhs lvalue of readonly value *) | [ I_ldflda (fspec) | I_ldsflda (fspec) ],[lhs] -> if context <> DirectArg && cenv.reportErrors then - errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(fspec.Name), m)); + errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(fspec.Name), m)) CheckExprInContext cenv env lhs DirectArg (* permit byref for lhs lvalue *) | [ I_ldelema (_,isNativePtr,_,_) ],lhsArray::indices -> if not(isNativePtr) && context <> DirectArg && cenv.reportErrors then - errorR(Error(FSComp.SR.chkNoAddressOfArrayElementAtThisPoint(), m)); + errorR(Error(FSComp.SR.chkNoAddressOfArrayElementAtThisPoint(), m)) CheckExprInContext cenv env lhsArray DirectArg (* permit byref for lhs lvalue *) CheckExprs cenv env indices + | [ AI_conv _ ],_ -> + CheckExprDirectArgs cenv env args (* permit byref for args to conv *) | _instrs -> CheckExprs cenv env args end | TOp.TraitCall _,_,_,_ -> - CheckTypeInstNoByrefs cenv env m tyargs; + CheckTypeInstNoByrefs cenv env m tyargs CheckExprDirectArgs cenv env args (* allow args to be byref here *) | ( TOp.Tuple @@ -796,7 +818,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context = | TOp.RefAddrGet | _ (* catch all! *) ),_,_,_ -> - CheckTypeInstNoByrefs cenv env m tyargs; + CheckTypeInstNoByrefs cenv env m tyargs CheckExprs cenv env args and CheckLambdas (memInfo: ValMemberInfo option) cenv env inlined topValInfo alwaysCheckNoReraise e m ety = @@ -828,18 +850,18 @@ and CheckLambdas (memInfo: ValMemberInfo option) cenv env inlined topValInfo alw // any byRef arguments are considered used, as they may be 'out's restArgs |> List.iter (fun arg -> if isByrefTy cenv.g arg.Type then arg.SetHasBeenReferenced()) - syntacticArgs |> List.iter (CheckValSpec cenv env); - syntacticArgs |> List.iter (BindVal cenv); + syntacticArgs |> List.iter (CheckValSpec cenv env) + syntacticArgs |> List.iter (BindVal cenv) // Allow access to protected things within members match memInfo with | None -> () | Some membInfo -> - testHookMemberBody membInfo body; + testHookMemberBody membInfo body - let freesOpt = CheckEscapes cenv (isSome(memInfo)) m syntacticArgs body; - CheckNoReraise cenv freesOpt body; (* no reraise under lambda expression *) - CheckExpr cenv env body; + let freesOpt = CheckEscapes cenv (isSome(memInfo)) m syntacticArgs body + CheckNoReraise cenv freesOpt body (* no reraise under lambda expression *) + CheckExpr cenv env body if cenv.reportErrors then if not inlined then CheckForByrefLikeType cenv env bodyty (fun () -> @@ -852,13 +874,13 @@ and CheckLambdas (memInfo: ValMemberInfo option) cenv env inlined topValInfo alw errorR(Error(FSComp.SR.chkTyparMultipleClassConstraints(), m)) | _ -> - CheckTypePermitByrefs cenv env m ety; + CheckTypePermitByrefs cenv env m ety if not inlined && isByrefLikeTy cenv.g ety then CheckExprInContext cenv env e DirectArg (* allow byref to occur as RHS of byref binding. *) else CheckExpr cenv env e if alwaysCheckNoReraise then - CheckNoReraise cenv None e; (* no reraise *) + CheckNoReraise cenv None e (* no reraise *) and CheckExprsInContext cenv env exprs arities = let arities = Array.ofList arities @@ -874,24 +896,24 @@ and CheckFlatExprs cenv env exprs = and CheckExprDirectArgs cenv env exprs = exprs |> List.iter (fun x -> CheckExprInContext cenv env x DirectArg) -and CheckDecisionTreeTargets cenv env targets = - targets |> Array.iter (CheckDecisionTreeTarget cenv env) +and CheckDecisionTreeTargets cenv env targets context = + targets |> Array.iter (CheckDecisionTreeTarget cenv env context ) -and CheckDecisionTreeTarget cenv env (TTarget(vs,e,_)) = +and CheckDecisionTreeTarget cenv env context (TTarget(vs,e,_)) = BindVals cenv vs vs |> FlatList.iter (CheckValSpec cenv env) - CheckExpr cenv env e + CheckExprInContext cenv env e context and CheckDecisionTree cenv env x = match x with - | TDSuccess (es,_) -> CheckFlatExprs cenv env es; + | TDSuccess (es,_) -> CheckFlatExprs cenv env es | TDBind(bind,rest) -> CheckBinding cenv env false bind; CheckDecisionTree cenv env rest | TDSwitch (e,cases,dflt,m) -> CheckDecisionTreeSwitch cenv env (e,cases,dflt,m) and CheckDecisionTreeSwitch cenv env (e,cases,dflt,m) = - CheckExpr cenv env e; - List.iter (fun (TCase(discrim,e)) -> CheckDecisionTreeTest cenv env m discrim; CheckDecisionTree cenv env e) cases; - Option.iter (CheckDecisionTree cenv env) dflt + CheckExprInContext cenv env e DirectArg // can be byref for struct union switch + cases |> List.iter (fun (TCase(discrim,e)) -> CheckDecisionTreeTest cenv env m discrim; CheckDecisionTree cenv env e) + dflt |> Option.iter (CheckDecisionTree cenv env) and CheckDecisionTreeTest cenv env m discrim = match discrim with @@ -903,13 +925,13 @@ and CheckDecisionTreeTest cenv env m discrim = | Test.ActivePatternCase (exp,_,_,_,_) -> CheckExpr cenv env exp and CheckAttrib cenv env (Attrib(_,_,args,props,_,_,_)) = - props |> List.iter (fun (AttribNamedArg(_,_,_,expr)) -> CheckAttribExpr cenv env expr); + props |> List.iter (fun (AttribNamedArg(_,_,_,expr)) -> CheckAttribExpr cenv env expr) args |> List.iter (CheckAttribExpr cenv env) and CheckAttribExpr cenv env (AttribExpr(expr,vexpr)) = - CheckExpr cenv env expr; - CheckExpr cenv env vexpr; - CheckNoReraise cenv None expr; + CheckExpr cenv env expr + CheckExpr cenv env vexpr + CheckNoReraise cenv None expr CheckAttribArgExpr cenv env vexpr and CheckAttribArgExpr cenv env expr = @@ -948,7 +970,7 @@ and CheckAttribArgExpr cenv env expr = | EnumExpr cenv.g arg1 -> CheckAttribArgExpr cenv env arg1 | AttribBitwiseOrExpr cenv.g (arg1,arg2) -> - CheckAttribArgExpr cenv env arg1; + CheckAttribArgExpr cenv env arg1 CheckAttribArgExpr cenv env arg2 | _ -> if cenv.reportErrors then @@ -975,15 +997,15 @@ and CheckAttribs cenv env (attribs: Attribs) = attribs |> List.iter (CheckAttrib cenv env) and CheckValInfo cenv env (ValReprInfo(_,args,ret)) = - args |> List.iterSquared (CheckArgInfo cenv env); - ret |> CheckArgInfo cenv env; + args |> List.iterSquared (CheckArgInfo cenv env) + ret |> CheckArgInfo cenv env and CheckArgInfo cenv env (argInfo : ArgReprInfo) = CheckAttribs cenv env argInfo.Attribs and CheckValSpec cenv env (v:Val) = - v.Attribs |> CheckAttribs cenv env; - v.ValReprInfo |> Option.iter (CheckValInfo cenv env); + v.Attribs |> CheckAttribs cenv env + v.ValReprInfo |> Option.iter (CheckValInfo cenv env) v.Type |> CheckTypePermitByrefs cenv env v.Range and AdjustAccess isHidden (cpath: unit -> CompilationPath) access = @@ -1009,9 +1031,9 @@ and CheckBinding cenv env alwaysCheckNoReraise (TBind(v,e,_) as bind) = let nm = v.DisplayName errorR(Error(FSComp.SR.chkMemberUsedInInvalidWay(nm, nm, stringOfRange m), v.Range)) - v.Type |> CheckTypePermitByrefs cenv env v.Range; - v.Attribs |> CheckAttribs cenv env; - v.ValReprInfo |> Option.iter (CheckValInfo cenv env); + v.Type |> CheckTypePermitByrefs cenv env v.Range + v.Attribs |> CheckAttribs cenv env + v.ValReprInfo |> Option.iter (CheckValInfo cenv env) if (v.IsMemberOrModuleBinding || v.IsMember) && not v.IsIncrClassGeneratedMember then let access = AdjustAccess (IsHiddenVal env.sigToImplRemapInfo v) (fun () -> v.TopValActualParent.CompilationPath) v.Accessibility CheckTypeForAccess cenv env (fun () -> NicePrint.stringOfQualifiedValOrMember cenv.denv v) access v.Range v.Type @@ -1020,7 +1042,7 @@ and CheckBinding cenv env alwaysCheckNoReraise (TBind(v,e,_) as bind) = if cenv.reportErrors then if isByrefLikeTy cenv.g v.Type && isSome bind.Var.ValReprInfo then - errorR(Error(FSComp.SR.chkNoByrefAsTopValue(), v.Range)); + errorR(Error(FSComp.SR.chkNoByrefAsTopValue(), v.Range)) // Check top-level let-bound values (arity=0 so not compiled not method) for byref types (not allowed) match bind.Var.ValReprInfo with @@ -1090,7 +1112,7 @@ and CheckBinding cenv env alwaysCheckNoReraise (TBind(v,e,_) as bind) = let inlined = v.MustInline // certain inline functions are permitted to have byref return types // e.g. for the byref operator itself, &. - CheckLambdas v.MemberInfo cenv env inlined topValInfo alwaysCheckNoReraise e v.Range v.Type; + CheckLambdas v.MemberInfo cenv env inlined topValInfo alwaysCheckNoReraise e v.Range v.Type and CheckBindings cenv env xs = FlatList.iter (CheckBinding cenv env false) xs @@ -1098,7 +1120,7 @@ and CheckBindings cenv env xs = FlatList.iter (CheckBinding cenv env false) xs let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = let isExplicitEntryPoint = HasFSharpAttribute cenv.g cenv.g.attrib_EntryPointAttribute v.Attribs if isExplicitEntryPoint then - cenv.entryPointGiven <- true; + cenv.entryPointGiven <- true let isLastCompiland = fst cenv.isLastCompiland if not isLastCompiland && cenv.reportErrors then errorR(Error(FSComp.SR.chkEntryPointUsage(), v.Range)) @@ -1143,20 +1165,20 @@ let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = tcref.ModuleOrNamespaceType.AllValsByLogicalName.ContainsKey(nm) && not (valEq tcref.ModuleOrNamespaceType.AllValsByLogicalName.[nm] v) then - error(Duplicate(kind,v.DisplayName,v.Range)); + error(Duplicate(kind,v.DisplayName,v.Range)) #if CASES_IN_NESTED_CLASS if tcref.IsUnionTycon && nm = "Cases" then - errorR(NameClash(nm,kind,v.DisplayName,v.Range, "generated type","Cases",tcref.Range)); + errorR(NameClash(nm,kind,v.DisplayName,v.Range, "generated type","Cases",tcref.Range)) #endif if tcref.IsUnionTycon then match nm with - | "Tag" -> errorR(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoGeneratedProperty(),"Tag",tcref.Range)); - | "Tags" -> errorR(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoGeneratedType(),"Tags",tcref.Range)); + | "Tag" -> errorR(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoGeneratedProperty(),"Tag",tcref.Range)) + | "Tags" -> errorR(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoGeneratedType(),"Tags",tcref.Range)) | _ -> if hasDefaultAugmentation then match tcref.GetUnionCaseByName(nm) with - | Some(uc) -> error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoUnionCase(),uc.DisplayName,uc.Range)); + | Some(uc) -> error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoUnionCase(),uc.DisplayName,uc.Range)) | None -> () let hasNoArgs = @@ -1168,24 +1190,24 @@ let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = if tcref.UnionCasesArray.Length = 1 && hasNoArgs then let ucase1 = tcref.UnionCasesArray.[0] for f in ucase1.RecdFieldsArray do - if f.Name = nm then error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoGeneratedProperty(),f.Name,ucase1.Range)); + if f.Name = nm then error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoGeneratedProperty(),f.Name,ucase1.Range)) // Default augmentation contains the nasty 'Case' etc. let prefix = "New" if nm.StartsWith prefix then match tcref.GetUnionCaseByName(nm.[prefix.Length ..]) with - | Some(uc) -> error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.chkUnionCaseCompiledForm(),uc.DisplayName,uc.Range)); + | Some(uc) -> error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.chkUnionCaseCompiledForm(),uc.DisplayName,uc.Range)) | None -> () // Default augmentation contains the nasty 'Is' etc. let prefix = "Is" if nm.StartsWith prefix && hasDefaultAugmentation then match tcref.GetUnionCaseByName(nm.[prefix.Length ..]) with - | Some(uc) -> error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.chkUnionCaseDefaultAugmentation(),uc.DisplayName,uc.Range)); + | Some(uc) -> error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.chkUnionCaseDefaultAugmentation(),uc.DisplayName,uc.Range)) | None -> () match tcref.GetFieldByName(nm) with - | Some(rf) -> error(NameClash(nm,kind,v.DisplayName,v.Range,"field",rf.Name,rf.Range)); + | Some(rf) -> error(NameClash(nm,kind,v.DisplayName,v.Range,"field",rf.Name,rf.Range)) | None -> () check false v.CoreDisplayName @@ -1215,7 +1237,7 @@ let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = match TryChopPropertyName v.DisplayName with | Some res -> check true res | None -> () - with e -> errorRecovery e v.Range; + with e -> errorRecovery e v.Range end CheckBinding cenv env true bind @@ -1232,10 +1254,10 @@ let CheckRecdField isUnion cenv env (tycon:Tycon) (rfield:RecdField) = IsHiddenTyconRepr env.sigToImplRemapInfo tycon || (not isUnion && IsHiddenRecdField env.sigToImplRemapInfo ((mkLocalTyconRef tycon).MakeNestedRecdFieldRef rfield)) let access = AdjustAccess isHidden (fun () -> tycon.CompilationPath) rfield.Accessibility - CheckTypeForAccess cenv env (fun () -> rfield.Name) access rfield.Range rfield.FormalType; - CheckTypePermitByrefs cenv env rfield.Range rfield.FormalType; - CheckAttribs cenv env rfield.PropertyAttribs; - CheckAttribs cenv env rfield.FieldAttribs; + CheckTypeForAccess cenv env (fun () -> rfield.Name) access rfield.Range rfield.FormalType + CheckTypePermitByrefs cenv env rfield.Range rfield.FormalType + CheckAttribs cenv env rfield.PropertyAttribs + CheckAttribs cenv env rfield.FieldAttribs if cenv.reportErrors then CheckForByrefLikeType cenv env rfield.FormalType (fun () -> errorR(Error(FSComp.SR.chkCantStoreByrefValue(), tycon.Range))) @@ -1246,7 +1268,7 @@ let CheckEntityDefn cenv env (tycon:Entity) = let env = { env with reflect = env.reflect || HasFSharpAttribute cenv.g cenv.g.attrib_ReflectedDefinitionAttribute tycon.Attribs } let m = tycon.Range let env = BindTypars cenv.g env (tycon.Typars(m)) - CheckAttribs cenv env tycon.Attribs; + CheckAttribs cenv env tycon.Attribs if cenv.reportErrors then begin if not tycon.IsTypeAbbrev then @@ -1315,15 +1337,42 @@ let CheckEntityDefn cenv env (tycon:Entity) = else errorR(Error(FSComp.SR.chkDuplicateMethodWithSuffix(nm),m)) - if minfo.NumArgs.Length > 1 && others |> List.exists (fun minfo2 -> not (IsAbstractDefaultPair2 minfo minfo2)) then + let numCurriedArgSets = minfo.NumArgs.Length + + if numCurriedArgSets > 1 && others |> List.exists (fun minfo2 -> not (IsAbstractDefaultPair2 minfo minfo2)) then errorR(Error(FSComp.SR.chkDuplicateMethodCurried nm,m)) - if minfo.NumArgs.Length > 1 && + if numCurriedArgSets > 1 && (minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst) - |> List.existsSquared (fun (ParamData(isParamArrayArg, isOutArg, optArgInfo, _, reflArgInfo, ty)) -> - isParamArrayArg || isOutArg || reflArgInfo.AutoQuote || optArgInfo.IsOptional || isByrefTy cenv.g ty)) then + |> List.existsSquared (fun (ParamData(isParamArrayArg, isOutArg, optArgInfo, callerInfoInfo, _, reflArgInfo, ty)) -> + isParamArrayArg || isOutArg || reflArgInfo.AutoQuote || optArgInfo.IsOptional || callerInfoInfo <> NoCallerInfo || isByrefTy cenv.g ty)) then errorR(Error(FSComp.SR.chkCurriedMethodsCantHaveOutParams(), m)) + if numCurriedArgSets = 1 then + minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst) + |> List.iterSquared (fun (ParamData(_, _, optArgInfo, callerInfoInfo, _, _, ty)) -> + match (optArgInfo, callerInfoInfo) with + | _, NoCallerInfo -> () + | NotOptional, _ -> errorR(Error(FSComp.SR.tcCallerInfoNotOptional(callerInfoInfo.ToString()),m)) + | CallerSide(_), CallerLineNumber -> + if not (typeEquiv cenv.g cenv.g.int32_ty ty) then + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfoInfo.ToString(), "int", NicePrint.minimalStringOfType cenv.denv ty),m)) + | CalleeSide, CallerLineNumber -> + if not ((isOptionTy cenv.g ty) && (typeEquiv cenv.g cenv.g.int32_ty (destOptionTy cenv.g ty))) then + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfoInfo.ToString(), "int", NicePrint.minimalStringOfType cenv.denv (destOptionTy cenv.g ty)),m)) + | CallerSide(_), CallerFilePath -> + if not (typeEquiv cenv.g cenv.g.string_ty ty) then + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfoInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv ty),m)) + | CalleeSide, CallerFilePath -> + if not ((isOptionTy cenv.g ty) && (typeEquiv cenv.g cenv.g.string_ty (destOptionTy cenv.g ty))) then + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfoInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy cenv.g ty)),m)) + | CallerSide(_), CallerMemberName -> + if not (typeEquiv cenv.g cenv.g.string_ty ty) then + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfoInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv ty),m)) + | CalleeSide, CallerMemberName -> + if not ((isOptionTy cenv.g ty) && (typeEquiv cenv.g cenv.g.string_ty (destOptionTy cenv.g ty))) then + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfoInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy cenv.g ty)),m))) + for pinfo in immediateProps do let nm = pinfo.PropertyName let m = (match pinfo.ArbitraryValRef with None -> m | Some vref -> vref.DefinitionRange) @@ -1407,23 +1456,23 @@ let CheckEntityDefn cenv env (tycon:Entity) = else errorR(Error(FSComp.SR.chkDuplicateMethodInheritedTypeWithSuffix(nm),m)) - end; + end // Considers TFSharpObjectRepr, TRecdRepr and TUnionRepr. // [Review] are all cases covered: TILObjectRepr,TAsmRepr. [Yes - these are FSharp.Core.dll only] - tycon.AllFieldsArray |> Array.iter (CheckRecdField false cenv env tycon); - abstractSlotValsOfTycons [tycon] |> List.iter (typeOfVal >> CheckTypePermitByrefs cenv env m); (* check vslots = abstract slots *) - tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.iter (CheckTypePermitByrefs cenv env m); (* check implemented interface types *) - superOfTycon cenv.g tycon |> CheckTypePermitByrefs cenv env m; (* check super type *) + tycon.AllFieldsArray |> Array.iter (CheckRecdField false cenv env tycon) + abstractSlotValsOfTycons [tycon] |> List.iter (typeOfVal >> CheckTypePermitByrefs cenv env m) (* check vslots = abstract slots *) + tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.iter (CheckTypePermitByrefs cenv env m) (* check implemented interface types *) + superOfTycon cenv.g tycon |> CheckTypePermitByrefs cenv env m (* check super type *) if tycon.IsUnionTycon then (* This covers finite unions. *) tycon.UnionCasesAsList |> List.iter (fun uc -> - CheckAttribs cenv env uc.Attribs; + CheckAttribs cenv env uc.Attribs uc.RecdFields |> List.iter (CheckRecdField true cenv env tycon)) let access = AdjustAccess (IsHiddenTycon env.sigToImplRemapInfo tycon) (fun () -> tycon.CompilationPath) tycon.Accessibility let visitType ty = CheckTypeForAccess cenv env (fun () -> tycon.DisplayNameWithStaticParametersAndUnderscoreTypars) access tycon.Range ty - abstractSlotValsOfTycons [tycon] |> List.iter (typeOfVal >> visitType); (* check vslots = abstract slots *) + abstractSlotValsOfTycons [tycon] |> List.iter (typeOfVal >> visitType) (* check vslots = abstract slots *) superOfTycon cenv.g tycon |> visitType // We do not have to check access of interface implementations. See FSharp 1.0 5042 //implements_of_tycon cenv.g tycon |> List.iter visitType @@ -1434,7 +1483,7 @@ let CheckEntityDefn cenv env (tycon:Entity) = | TTyconDelegate ss -> //ss.ClassTypars //ss.MethodTypars - ss.FormalReturnType |> Option.iter visitType; + ss.FormalReturnType |> Option.iter visitType ss.FormalParams |> List.iterSquared (fun (TSlotParam(_,ty,_,_,_,_)) -> visitType ty) | _ -> () | _ -> () @@ -1464,7 +1513,7 @@ let CheckEntityDefn cenv env (tycon:Entity) = if zeroInitUnsafe = Some(true) then let ty' = generalizedTyconRef (mkLocalTyconRef tycon) if not (TypeHasDefaultValue cenv.g m ty') then - errorR(Error(FSComp.SR.chkValueWithDefaultValueMustHaveDefaultValue(), m)); + errorR(Error(FSComp.SR.chkValueWithDefaultValueMustHaveDefaultValue(), m)) ) match tycon.TypeAbbrev with (* And type abbreviations *) | None -> () @@ -1505,7 +1554,7 @@ and CheckDefnInModule cenv env x = BindVal cenv bind.Var | TMDefDo(e,m) -> CheckNothingAfterEntryPoint cenv m - CheckNoReraise cenv None e; + CheckNoReraise cenv None e CheckExpr cenv env e | TMAbstract(def) -> CheckModuleExpr cenv env def | TMDefs(defs) -> CheckDefnsInModule cenv env defs @@ -1516,23 +1565,23 @@ and CheckModuleSpec cenv env x = BindVals cenv (valsOfBinds [bind]) CheckModuleBinding cenv env bind | ModuleOrNamespaceBinding.Module (mspec, rhs) -> - CheckEntityDefn cenv env mspec; + CheckEntityDefn cenv env mspec let env = { env with reflect = env.reflect || HasFSharpAttribute cenv.g cenv.g.attrib_ReflectedDefinitionAttribute mspec.Attribs } CheckDefnInModule cenv env rhs let CheckTopImpl (g,amap,reportErrors,infoReader,internalsVisibleToPaths,viewCcu,denv ,mexpr,extraAttribs,(isLastCompiland:bool*bool)) = let cenv = - { g =g ; - reportErrors=reportErrors; - boundVals= new Dictionary<_,_>(100, HashIdentity.Structural); - potentialUnboundUsesOfVals=Map.empty; - usesQuotations=false; - infoReader=infoReader; - internalsVisibleToPaths=internalsVisibleToPaths; - amap=amap; - denv=denv; - viewCcu= viewCcu; - isLastCompiland=isLastCompiland; + { g =g + reportErrors=reportErrors + boundVals= new Dictionary<_,_>(100, HashIdentity.Structural) + potentialUnboundUsesOfVals=Map.empty + usesQuotations=false + infoReader=infoReader + internalsVisibleToPaths=internalsVisibleToPaths + amap=amap + denv=denv + viewCcu= viewCcu + isLastCompiland=isLastCompiland entryPointGiven=false} // Certain type equality checks go faster if these TyconRefs are pre-resolved. @@ -1554,8 +1603,8 @@ let CheckTopImpl (g,amap,reportErrors,infoReader,internalsVisibleToPaths,viewCcu boundTypars= TyparMap.Empty reflect=false } - CheckModuleExpr cenv env mexpr; - CheckAttribs cenv env extraAttribs; + CheckModuleExpr cenv env mexpr + CheckAttribs cenv env extraAttribs if cenv.usesQuotations && QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat(cenv.g) = QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus then viewCcu.UsesFSharp20PlusQuotations <- true cenv.entryPointGiven diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 22090236d4b..8b1dd7e1889 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -38,9 +38,9 @@ type QuotationSerializationFormat = | FSharp_20_Plus type QuotationGenerationScope = - { g: TcGlobals; - amap: Import.ImportMap; - scope: CcuThunk; + { g: TcGlobals + amap: Import.ImportMap + scope: CcuThunk // Accumulate the references to type definitions referencedTypeDefs: ResizeArray referencedTypeDefsTable: Dictionary @@ -78,10 +78,10 @@ type QuotationGenerationScope = type QuotationTranslationEnv = { //Map from Val to binding index - vs: ValMap; - nvs: int; + vs: ValMap + nvs: int //Map from typar stamps to binding index - tyvs: StampMap; + tyvs: StampMap // Map for values bound by the // 'let v = isinst e in .... if nonnull v then ...v .... ' // construct arising out the compilation of pattern matching. We decode these back to the form @@ -90,9 +90,9 @@ type QuotationTranslationEnv = substVals: ValMap } static member Empty = - { vs=ValMap<_>.Empty; - nvs=0; - tyvs = Map.empty ; + { vs=ValMap<_>.Empty + nvs=0 + tyvs = Map.empty isinstVals = ValMap<_>.Empty substVals = ValMap<_>.Empty } @@ -182,11 +182,11 @@ let rec EmitDebugInfoIfNecessary cenv env m astExpr : QP.ExprData = let rangeExpr = mk_tuple cenv.g m - [ mkString cenv.g m m.FileName; - mkInt cenv.g m m.StartLine; - mkInt cenv.g m m.StartColumn; - mkInt cenv.g m m.EndLine; - mkInt cenv.g m m.EndColumn; ] + [ mkString cenv.g m m.FileName + mkInt cenv.g m m.StartLine + mkInt cenv.g m m.StartColumn + mkInt cenv.g m m.EndLine + mkInt cenv.g m m.EndColumn; ] let attrExpr = mk_tuple cenv.g m [ mkString cenv.g m "DebugRange"; rangeExpr ] @@ -224,7 +224,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. match (freeInExpr CollectTyparsAndLocalsNoCaching x0).FreeLocals |> Seq.tryPick (fun v -> if env.vs.ContainsVal v then Some(v) else None) with | Some v -> errorR(Error(FSComp.SR.crefBoundVarUsedInSplice(v.DisplayName), v.Range)) | None -> () - cenv.exprSplices.Add((x0, m)); + cenv.exprSplices.Add((x0, m)) let hole = QP.mkHole(ConvType cenv env m ty,idx) (hole, rest) ||> List.fold (fun fR arg -> QP.mkApp (fR,ConvExpr cenv env arg)) @@ -345,7 +345,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. // Simple applications | Expr.App(f,_fty,tyargs,args,m) -> - if nonNil tyargs then wfail(Error(FSComp.SR.crefQuotationsCantContainGenericExprs(), m)); + if nonNil tyargs then wfail(Error(FSComp.SR.crefQuotationsCantContainGenericExprs(), m)) List.fold (fun fR arg -> QP.mkApp (fR,ConvExpr cenv env arg)) (ConvExpr cenv env f) args // REVIEW: what is the quotation view of literals accessing enumerations? Currently they show up as integers. @@ -433,6 +433,9 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | TOp.ValFieldGetAddr(_rfref),_tyargs,_ -> wfail(Error(FSComp.SR.crefQuotationsCantContainAddressOf(), m)) + | TOp.UnionCaseFieldGetAddr _,_tyargs,_ -> + wfail(Error(FSComp.SR.crefQuotationsCantContainAddressOf(), m)) + | TOp.ValFieldGet(_rfref),_tyargs,[] -> wfail(Error(FSComp.SR.crefQuotationsCantContainStaticFieldRef(),m)) @@ -475,8 +478,8 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let methArgTypesR = ConvTypes cenv env m argtys let argsR = ConvExprs cenv env args let objR = - QP.mkCtorCall( { ctorParent = parentTyconR; - ctorArgTypes = methArgTypesR }, + QP.mkCtorCall( { ctorParent = parentTyconR + ctorArgTypes = methArgTypesR }, [], argsR) let exnTypeR = ConvType cenv env m cenv.g.exn_ty QP.mkCoerce(exnTypeR, objR) @@ -684,17 +687,19 @@ and ConvObjectModelCallCore cenv env m (isPropGet,isPropSet,isNewObj,parentTycon QP.mkPropSet( (parentTyconR, propName,propTy,args),tyargsR, callArgsR) elif isNewObj then - QP.mkCtorCall( { ctorParent = parentTyconR; - ctorArgTypes = methArgTypesR }, - tyargsR, callArgsR) + let ctorR : QuotationPickler.CtorData = + { ctorParent = parentTyconR + ctorArgTypes = methArgTypesR } + QP.mkCtorCall(ctorR, tyargsR, callArgsR) else - QP.mkMethodCall( { methParent = parentTyconR; - methArgTypes = methArgTypesR; - methRetType = methRetTypeR; - methName = methName; - numGenericArgs=numGenericArgs }, - tyargsR, callArgsR) + let methR : QuotationPickler.MethodData = + { methParent = parentTyconR + methArgTypes = methArgTypesR + methRetType = methRetTypeR + methName = methName + numGenericArgs=numGenericArgs } + QP.mkMethodCall(methR, tyargsR, callArgsR) and ConvModuleValueApp cenv env m (vref:ValRef) tyargs (args: Expr list list) = EmitDebugInfoIfNecessary cenv env m (ConvModuleValueAppCore cenv env m vref tyargs args) @@ -724,7 +729,7 @@ and private ConvValRefCore holeOk cenv env m (vref:ValRef) tyargs = let e = env.substVals.[v] ConvExpr cenv env e elif env.vs.ContainsVal v then - if nonNil tyargs then wfail(InternalError("ignoring generic application of local quoted variable",m)); + if nonNil tyargs then wfail(InternalError("ignoring generic application of local quoted variable",m)) QP.mkVar(env.vs.[v]) elif v.BaseOrThisInfo = CtorThisVal && cenv.isReflectedDefinition = IsReflectedDefinition.Yes then QP.mkThisVar(ConvType cenv env m v.Type) @@ -735,7 +740,7 @@ and private ConvValRefCore holeOk cenv env m (vref:ValRef) tyargs = // References to local values are embedded by value if not holeOk then wfail(Error(FSComp.SR.crefNoSetOfHole(),m)) let idx = cenv.exprSplices.Count - cenv.exprSplices.Add((mkCallLiftValueWithName cenv.g m vty v.LogicalName (exprForValRef m vref), m)); + cenv.exprSplices.Add((mkCallLiftValueWithName cenv.g m vty v.LogicalName (exprForValRef m vref), m)) QP.mkHole(ConvType cenv env m vty,idx) | Parent _ -> ConvModuleValueApp cenv env m vref tyargs [] @@ -769,7 +774,7 @@ and ConvTyparRef cenv env m (tp:Typar) = | Some idx -> idx | None -> let idx = cenv.typeSplices.Count - cenv.typeSplices.Add((tp, m)); + cenv.typeSplices.Add((tp, m)) idx and FilterMeasureTyargs tys = @@ -1019,14 +1024,14 @@ let ConvMethodBase cenv env (methName, v:Val) = if isNewObj then QP.MethodBaseData.Ctor - { ctorParent = parentTyconR; + { ctorParent = parentTyconR ctorArgTypes = methArgTypesR } else QP.MethodBaseData.Method - { methParent = parentTyconR; - methArgTypes = methArgTypesR; - methRetType = methRetTypeR; - methName = methName; + { methParent = parentTyconR + methArgTypes = methArgTypesR + methRetType = methRetTypeR + methName = methName numGenericArgs=numGenericArgs } | _ when v.IsExtensionMember -> @@ -1047,8 +1052,8 @@ let ConvMethodBase cenv env (methName, v:Val) = | _ -> QP.MethodBaseData.ModuleDefn - { Name = methName; - Module = parentTyconR; + { Name = methName + Module = parentTyconR IsProperty = IsCompiledAsStaticProperty cenv.g v } diff --git a/src/fsharp/ReferenceResolution.fs b/src/fsharp/ReferenceResolution.fs index 7340b8a429f..6c0685349b1 100644 --- a/src/fsharp/ReferenceResolution.fs +++ b/src/fsharp/ReferenceResolution.fs @@ -39,7 +39,6 @@ module internal MSBuildResolver = open Microsoft.Build.Tasks open Microsoft.Build.Utilities open Microsoft.Build.Framework - open Microsoft.Build.BuildEngine open System.IO type ResolvedFile = diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 57320d2205e..2be517b27dd 100755 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -536,7 +536,7 @@ let rec sizeMeasure g ms = // Some basic type builders //--------------------------------------------------------------------------- -let mkNativePtrType g ty = TType_app (g.nativeptr_tcr, [ty]) +let mkNativePtrTy g ty = TType_app (g.nativeptr_tcr, [ty]) let mkByrefTy g ty = TType_app (g.byref_tcr, [ty]) let mkArrayTy g rank ty m = @@ -1181,24 +1181,34 @@ let mkStaticRecdFieldGetAddr(fref,tinst,m) = Expr.Op (TOp.ValFieldGetAd let mkStaticRecdFieldGet(fref,tinst,m) = Expr.Op (TOp.ValFieldGet(fref), tinst, [],m) let mkStaticRecdFieldSet(fref,tinst,e,m) = Expr.Op (TOp.ValFieldSet(fref), tinst, [e],m) -let mkRecdFieldSetViaExprAddr(e1,fref,tinst,e2,m) = Expr.Op (TOp.ValFieldSet(fref), tinst, [e1;e2],m) +let mkArrayElemAddress g (readonly,isNativePtr,shape,elemTy,aexpr,nexpr,m) = Expr.Op (TOp.ILAsm ([IL.I_ldelema(readonly,isNativePtr,shape,mkILTyvarTy 0us)],[mkByrefTy g elemTy]), [elemTy],[aexpr;nexpr],m) -let mkUnionCaseTagGet(e1,cref,tinst,m) = Expr.Op (TOp.UnionCaseTagGet(cref), tinst, [e1],m) -let mkUnionCaseProof(e1,cref,tinst,m) = Expr.Op (TOp.UnionCaseProof(cref), tinst, [e1],m) +let mkRecdFieldSetViaExprAddr (e1,fref,tinst,e2,m) = Expr.Op (TOp.ValFieldSet(fref), tinst, [e1;e2],m) -/// Build a 'get' expression for something we've already determined to be a particular union case, and where the -/// input expression has 'TType_ucase', which is an F# compiler internal "type" -let mkUnionCaseFieldGetProven(e1,cref,tinst,j,m) = Expr.Op (TOp.UnionCaseFieldGet(cref,j), tinst, [e1],m) +let mkUnionCaseTagGetViaExprAddr (e1,cref,tinst,m) = Expr.Op (TOp.UnionCaseTagGet(cref), tinst, [e1],m) + +/// Make a 'TOp.UnionCaseProof' expression, which proves a union value is over a particular case (used only for ref-unions, not struct-unions) +let mkUnionCaseProof (e1,cref:UnionCaseRef,tinst,m) = if cref.Tycon.IsStructOrEnumTycon then e1 else Expr.Op (TOp.UnionCaseProof(cref), tinst, [e1],m) + +/// Build a 'TOp.UnionCaseFieldGet' expression for something we've already determined to be a particular union case. For ref-unions, +/// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, +/// the input should be the address of the expression. +let mkUnionCaseFieldGetProvenViaExprAddr (e1,cref,tinst,j,m) = Expr.Op (TOp.UnionCaseFieldGet(cref,j), tinst, [e1],m) + +/// Build a 'TOp.UnionCaseFieldGetAddr' expression for a field of a union when we've already determined the value to be a particular union case. For ref-unions, +/// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, +/// the input should be the address of the expression. +let mkUnionCaseFieldGetAddrProvenViaExprAddr (e1,cref,tinst,j,m) = Expr.Op (TOp.UnionCaseFieldGetAddr(cref,j), tinst, [e1],m) /// Build a 'get' expression for something we've already determined to be a particular union case, but where /// the static type of the input is not yet proven to be that particular union case. This requires a type /// cast to 'prove' the condition. -let mkUnionCaseFieldGetUnproven(e1,cref,tinst,j,m) = mkUnionCaseFieldGetProven(mkUnionCaseProof(e1,cref,tinst,m),cref,tinst,j,m) +let mkUnionCaseFieldGetUnprovenViaExprAddr (e1,cref,tinst,j,m) = mkUnionCaseFieldGetProvenViaExprAddr(mkUnionCaseProof(e1,cref,tinst,m),cref,tinst,j,m) -let mkUnionCaseFieldSet(e1,cref,tinst,j,e2,m) = Expr.Op (TOp.UnionCaseFieldSet(cref,j), tinst, [e1;e2],m) +let mkUnionCaseFieldSet (e1,cref,tinst,j,e2,m) = Expr.Op (TOp.UnionCaseFieldSet(cref,j), tinst, [e1;e2],m) -let mkExnCaseFieldGet(e1,ecref,j,m) = Expr.Op (TOp.ExnFieldGet(ecref,j), [],[e1],m) -let mkExnCaseFieldSet(e1,ecref,j,e2,m) = Expr.Op (TOp.ExnFieldSet(ecref,j), [],[e1;e2],m) +let mkExnCaseFieldGet (e1,ecref,j,m) = Expr.Op (TOp.ExnFieldGet(ecref,j), [],[e1],m) +let mkExnCaseFieldSet (e1,ecref,j,e2,m) = Expr.Op (TOp.ExnFieldSet(ecref,j), [],[e1;e2],m) let mkDummyLambda g (e:Expr,ety) = let m = e.Range @@ -1310,6 +1320,9 @@ let actualTyOfRecdFieldForTycon tycon tinst (fspec:RecdField) = let actualTyOfRecdFieldRef (fref:RecdFieldRef) tinst = actualTyOfRecdFieldForTycon fref.Tycon tinst fref.RecdField +let actualTyOfUnionFieldRef (fref:UnionCaseRef) n tinst = + actualTyOfRecdFieldForTycon fref.Tycon tinst (fref.FieldByIndex(n)) + //--------------------------------------------------------------------------- // Apply type functions to types @@ -1456,6 +1469,7 @@ let isUnitTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> t let isObjTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g g.system_Object_tcref tcref | _ -> false) let isVoidTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g g.system_Void_tcref tcref | _ -> false) let isILAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tcref.IsILTycon | _ -> false) +let isNativePtrTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g g.nativeptr_tcr tcref | _ -> false) let isByrefTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g g.byref_tcr tcref | _ -> false) let isByrefLikeTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> isByrefLikeTyconRef g tcref | _ -> false) #if EXTENSIONTYPING @@ -2651,6 +2665,7 @@ let TyconRefHasAttribute g m attribSpec tcref = //------------------------------------------------------------------------- let destByrefTy g ty = if isByrefTy g ty then List.head (argsOfAppTy g ty) else failwith "destByrefTy: not a byref type" +let destNativePtrTy g ty = if isNativePtrTy g ty then List.head (argsOfAppTy g ty) else failwith "destNativePtrTy: not a native ptr type" let isRefCellTy g ty = match tryDestAppTy g ty with @@ -4138,6 +4153,7 @@ and accFreeInOp opts op acc = // Things containing just a union case reference | TOp.UnionCaseProof cr | TOp.UnionCase cr + | TOp.UnionCaseFieldGetAddr (cr,_) | TOp.UnionCaseFieldGet (cr,_) | TOp.UnionCaseFieldSet (cr,_) -> accFreeUnionCaseRef opts cr acc @@ -4549,7 +4565,7 @@ and remapExpr g (compgen:ValCopyFlag) (tmenv:Remap) x = List.map (remapMethod g compgen tmenvinner) overrides, List.map (remapInterfaceImpl g compgen tmenvinner) iimpls,m) - // Addresses of immutable field may "leak" across assembly boundaries - see CanTakeAddressOfRecdField below. + // Addresses of immutable field may "leak" across assembly boundaries - see CanTakeAddressOfRecdFieldRef below. // This is "ok", in the sense that it is always valid to fix these up to be uses // of a temporary local, e.g. // &(E.RF) --> let mutable v = E.RF in &v @@ -4563,6 +4579,15 @@ and remapExpr g (compgen:ValCopyFlag) (tmenv:Remap) x = let tmp,_ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfRecdFieldRef rfref tinst) mkCompGenLet m tmp (mkRecdFieldGetViaExprAddr(arg,rfref,tinst,m)) (mkValAddr m (mkLocalValRef tmp)) + | Expr.Op (TOp.UnionCaseFieldGetAddr (uref,cidx),tinst,[arg],m) when + not (uref.FieldByIndex(cidx).IsMutable) && + not (entityRefInThisAssembly g.compilingFslib uref.TyconRef) -> + + let tinst = remapTypes tmenv tinst + let arg = remapExpr g compgen tmenv arg + let tmp,_ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfUnionFieldRef uref cidx tinst) + mkCompGenLet m tmp (mkUnionCaseFieldGetProvenViaExprAddr(arg,uref,tinst,cidx,m)) (mkValAddr m (mkLocalValRef tmp)) + | Expr.Op (op,tinst,args,m) -> let op' = remapOp tmenv op let tinst' = remapTypes tmenv tinst @@ -5020,14 +5045,14 @@ and remarkBind m (TBind(v,repr,_)) = //-------------------------------------------------------------------------- let isRecdOrStructFieldAllocObservable (f:RecdField) = not f.IsStatic && f.IsMutable -let ucaseAllocObservable (uc:UnionCase) = uc.FieldTable.FieldsByIndex |> Array.exists isRecdOrStructFieldAllocObservable -let isUnionCaseAllocObservable (uc:UnionCaseRef) = uc.UnionCase |> ucaseAllocObservable +let isUnionCaseAllocObservable (uc:UnionCase) = uc.FieldTable.FieldsByIndex |> Array.exists isRecdOrStructFieldAllocObservable +let isUnionCaseRefAllocObservable (uc:UnionCaseRef) = uc.UnionCase |> isUnionCaseAllocObservable let isRecdOrUnionOrStructTyconAllocObservable (_g:TcGlobals) (tycon:Tycon) = - if tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then + if tycon.IsUnionTycon then + tycon.UnionCasesArray |> Array.exists isUnionCaseAllocObservable + elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then tycon.AllFieldsArray |> Array.exists isRecdOrStructFieldAllocObservable - elif tycon.IsUnionTycon then - tycon.UnionCasesArray |> Array.exists ucaseAllocObservable else false @@ -5122,6 +5147,7 @@ let rec tyOfExpr g e = | TOp.ValFieldGet(fref) -> actualTyOfRecdFieldRef fref tinst | (TOp.ValFieldSet _ | TOp.UnionCaseFieldSet _ | TOp.ExnFieldSet _ | TOp.LValueOp ((LSet | LByrefSet),_)) ->g.unit_ty | TOp.UnionCaseTagGet _ -> g.int_ty + | TOp.UnionCaseFieldGetAddr(cref,j) -> mkByrefTy g (actualTyOfRecdField (mkTyconRefInst cref.TyconRef tinst) (cref.FieldByIndex j)) | TOp.UnionCaseFieldGet(cref,j) -> actualTyOfRecdField (mkTyconRefInst cref.TyconRef tinst) (cref.FieldByIndex j) | TOp.ExnFieldGet(ecref,j) -> recdFieldTyOfExnDefRefByIdx ecref j | TOp.LValueOp (LByrefGet, v) -> destByrefTy g v.Type @@ -5346,13 +5372,13 @@ let mkAndSimplifyMatch spBind exprm matchm ty tree targets = //------------------------------------------------------------------------- -// mkExprAddrOfExpr +// mkExprAddrOfExprAux //------------------------------------------------------------------------- type Mutates = DefinitelyMutates | PossiblyMutates | NeverMutates exception DefensiveCopyWarning of string * range -let isRecdOrStuctTyImmutable g ty = +let isRecdOrStructTyImmutable g ty = match tryDestAppTy g ty with | None -> false | Some tcref -> @@ -5371,7 +5397,7 @@ let isRecdOrStuctTyImmutable g ty = // let g1 = A.G(1) // (fun () -> g1.x1) // -// Note: isRecdOrStuctTyImmutable implies PossiblyMutates or NeverMutates +// Note: isRecdOrStructTyImmutable implies PossiblyMutates or NeverMutates // // We only do this for true local or closure fields because we can't take adddresses of immutable static // fields across assemblies. @@ -5382,7 +5408,7 @@ let CanTakeAddressOfImmutableVal g (v:ValRef) mut = not v.IsMemberOrModuleBinding && (match mut with | NeverMutates -> true - | PossiblyMutates -> isRecdOrStuctTyImmutable g v.Type + | PossiblyMutates -> isRecdOrStructTyImmutable g v.Type | DefinitelyMutates -> false) let MustTakeAddressOfVal g (v:ValRef) = @@ -5390,48 +5416,61 @@ let MustTakeAddressOfVal g (v:ValRef) = // We can only take the address of mutable values in the same assembly valRefInThisAssembly g.compilingFslib v -let MustTakeAddressOfRecdField (rfref: RecdFieldRef) = +let MustTakeAddressOfRecdField (rf: RecdField) = // Static mutable fields must be private, hence we don't have to take their address - not rfref.RecdField.IsStatic && - rfref.RecdField.IsMutable + not rf.IsStatic && + rf.IsMutable -let CanTakeAddressOfRecdField g (rfref: RecdFieldRef) mut tinst = +let MustTakeAddressOfRecdFieldRef (rfref: RecdFieldRef) = MustTakeAddressOfRecdField rfref.RecdField + +let CanTakeAddressOfRecdFieldRef g (rfref: RecdFieldRef) mut tinst = mut <> DefinitelyMutates && // We only do this if the field is defined in this assembly because we can't take adddresses across assemblies for immutable fields entityRefInThisAssembly g.compilingFslib rfref.TyconRef && - isRecdOrStuctTyImmutable g (actualTyOfRecdFieldRef rfref tinst) + isRecdOrStructTyImmutable g (actualTyOfRecdFieldRef rfref tinst) + +let CanTakeAddressOfUnionFieldRef g (uref: UnionCaseRef) mut tinst cidx = + mut <> DefinitelyMutates && + // We only do this if the field is defined in this assembly because we can't take adddresses across assemblies for immutable fields + entityRefInThisAssembly g.compilingFslib uref.TyconRef && + isRecdOrStructTyImmutable g (actualTyOfUnionFieldRef uref cidx tinst) -let rec mkExprAddrOfExpr g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m = - if not mustTakeAddress then (fun x -> x),e else +let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m = + if not mustTakeAddress then None,e else match e with // LVALUE: "x" where "x" is byref | Expr.Op (TOp.LValueOp (LByrefGet, v), _,[], m) -> - (fun x -> x), exprForValRef m v + None, exprForValRef m v // LVALUE: "x" where "x" is mutable local, mutable intra-assembly module/static binding, or operation doesn't mutate // Note: we can always take the address of mutable values | Expr.Val(v, _,m) when MustTakeAddressOfVal g v || CanTakeAddressOfImmutableVal g v mut -> - (fun x -> x), mkValAddr m v - // LVALUE: "x" where "e.x" is mutable record field. "e" may be an lvalue - | Expr.Op (TOp.ValFieldGet rfref, tinst,[e],m) when MustTakeAddressOfRecdField rfref || CanTakeAddressOfRecdField g rfref mut tinst -> + None, mkValAddr m v + // LVALUE: "x" where "e.x" is record field. + | Expr.Op (TOp.ValFieldGet rfref, tinst,[e],m) when MustTakeAddressOfRecdFieldRef rfref || CanTakeAddressOfRecdFieldRef g rfref mut tinst -> let exprty = tyOfExpr g e - let wrap,expra = mkExprAddrOfExpr g (isStructTy g exprty) false mut e None m + let wrap,expra = mkExprAddrOfExprAux g (isStructTy g exprty) false mut e None m wrap, mkRecdFieldGetAddrViaExprAddr(expra,rfref,tinst,m) + // LVALUE: "x" where "e.x" is union field + | Expr.Op (TOp.UnionCaseFieldGet (uref,cidx), tinst,[e],m) when MustTakeAddressOfRecdField (uref.FieldByIndex(cidx)) || CanTakeAddressOfUnionFieldRef g uref mut tinst cidx -> + let exprty = tyOfExpr g e + let wrap,expra = mkExprAddrOfExprAux g (isStructTy g exprty) false mut e None m + wrap, mkUnionCaseFieldGetAddrProvenViaExprAddr(expra,uref,tinst,cidx,m) // LVALUE: "x" where "e.x" is a .NET static field. | Expr.Op (TOp.ILAsm ([IL.I_ldsfld(_vol,fspec)],[ty2]), tinst,[],m) -> - (fun x -> x),Expr.Op (TOp.ILAsm ([IL.I_ldsflda(fspec)],[mkByrefTy g ty2]), tinst,[],m) + None,Expr.Op (TOp.ILAsm ([IL.I_ldsflda(fspec)],[mkByrefTy g ty2]), tinst,[],m) // LVALUE: "x" where "e.x" is a .NET instance field. "e" may be an lvalue | Expr.Op (TOp.ILAsm ([IL.I_ldfld(_align,_vol,fspec)],[ty2]), tinst,[e],m) -> let exprty = tyOfExpr g e - let wrap,expra = mkExprAddrOfExpr g (isStructTy g exprty) false mut e None m + let wrap,expra = mkExprAddrOfExprAux g (isStructTy g exprty) false mut e None m wrap,Expr.Op (TOp.ILAsm ([IL.I_ldflda(fspec)],[mkByrefTy g ty2]), tinst,[expra],m) // LVALUE: "x" where "x" is mutable static field. - | Expr.Op (TOp.ValFieldGet rfref, tinst,[],m) when MustTakeAddressOfRecdField rfref || CanTakeAddressOfRecdField g rfref mut tinst -> - (fun x -> x), mkStaticRecdFieldGetAddr(rfref,tinst,m) + | Expr.Op (TOp.ValFieldGet rfref, tinst,[],m) when MustTakeAddressOfRecdFieldRef rfref || CanTakeAddressOfRecdFieldRef g rfref mut tinst -> + None, mkStaticRecdFieldGetAddr(rfref,tinst,m) // LVALUE: "e.[n]" where e is an array of structs | Expr.App(Expr.Val(vf,_,_),_,[elemTy],[aexpr;nexpr],_) @@ -5443,7 +5482,7 @@ let rec mkExprAddrOfExpr g mustTakeAddress useReadonlyForGenericArrayAddress mut match addrExprVal with | Some(vf) -> valRefEq g vf g.addrof2_vref | _ -> false - (fun x -> x), Expr.Op (TOp.ILAsm ([IL.I_ldelema(readonly,isNativePtr,shape,mkILTyvarTy 0us)],[mkByrefTy g elemTy]), [elemTy],[aexpr;nexpr],m) + None, mkArrayElemAddress g (readonly,isNativePtr,shape,elemTy,aexpr,nexpr,m) // LVALUE: "e.[n1,n2]", "e.[n1,n2,n3]", "e.[n1,n2,n3,n4]" where e is an array of structs | Expr.App(Expr.Val(vf,_,_),_,[elemTy],(aexpr::args),_) @@ -5456,7 +5495,7 @@ let rec mkExprAddrOfExpr g mustTakeAddress useReadonlyForGenericArrayAddress mut | Some(vf) -> valRefEq g vf g.addrof2_vref | _ -> false - (fun x -> x), Expr.Op (TOp.ILAsm ([IL.I_ldelema(readonly,isNativePtr,shape,mkILTyvarTy 0us)],[mkByrefTy g elemTy]), [elemTy],(aexpr::args),m) + None, Expr.Op (TOp.ILAsm ([IL.I_ldelema(readonly,isNativePtr,shape,mkILTyvarTy 0us)],[mkByrefTy g elemTy]), [elemTy],(aexpr::args),m) // Give a nice error message for DefinitelyMutates on immutable values, or mutable values in other assemblies | Expr.Val(v, _,m) when mut = DefinitelyMutates @@ -5476,16 +5515,28 @@ let rec mkExprAddrOfExpr g mustTakeAddress useReadonlyForGenericArrayAddress mut errorR(Error(FSComp.SR.tastInvalidMutationOfConstant(),m)); | PossiblyMutates -> warning(DefensiveCopyWarning(FSComp.SR.tastValueHasBeenCopied(),m)); - let tmp,_ = mkMutableCompGenLocal m "copyOfStruct" ty - (fun rest -> mkCompGenLet m tmp e rest), (mkValAddr m (mkLocalValRef tmp)) + let tmp,_ = + match mut with + | NeverMutates -> mkCompGenLocal m "copyOfStruct" ty + | _ -> mkMutableCompGenLocal m "copyOfStruct" ty + Some (tmp,e), (mkValAddr m (mkLocalValRef tmp)) + +let mkExprAddrOfExpr g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m = + let optBind, addre = mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m + match optBind with + | None -> (fun x -> x), addre + | Some (tmp,rval) -> (fun x -> mkCompGenLet m tmp rval x), addre let mkRecdFieldGet g (e,fref:RecdFieldRef,tinst,m) = + assert (not (isByrefTy g (tyOfExpr g e))) let wrap,e' = mkExprAddrOfExpr g fref.Tycon.IsStructOrEnumTycon false NeverMutates e None m wrap (mkRecdFieldGetViaExprAddr(e',fref,tinst,m)) -let mkRecdFieldSet g (e,fref:RecdFieldRef,tinst,e2,m) = - let wrap,e' = mkExprAddrOfExpr g fref.Tycon.IsStructOrEnumTycon false DefinitelyMutates e None m - wrap (mkRecdFieldSetViaExprAddr(e',fref,tinst,e2,m)) +let mkUnionCaseFieldGetUnproven g (e,cref:UnionCaseRef,tinst,j,m) = + assert (not (isByrefTy g (tyOfExpr g e))) + let wrap,e' = mkExprAddrOfExpr g cref.Tycon.IsStructOrEnumTycon false NeverMutates e None m + wrap (mkUnionCaseFieldGetUnprovenViaExprAddr (e',cref,tinst,j,m)) + let mkArray (argty, args, m) = Expr.Op(TOp.Array, [argty],args,m) @@ -5525,12 +5576,13 @@ let rec IterateRecursiveFixups g (selfv : Val option) rvs ((access : Expr),set) | Expr.Op (TOp.UnionCase (c),tinst,args,m) -> args |> List.iteri (fun n -> IterateRecursiveFixups g None rvs - (mkUnionCaseFieldGetUnproven(access,c,tinst,n,m), + (mkUnionCaseFieldGetUnprovenViaExprAddr (access,c,tinst,n,m), (fun e -> // NICE: it would be better to do this check in the type checker let tcref = c.TyconRef - errorR(Error(FSComp.SR.tastRecursiveValuesMayNotAppearInConstructionOfType(tcref.LogicalName),m)); - mkUnionCaseFieldSet(access,c,tinst,n,e,m)))) + if not (c.FieldByIndex(n)).IsMutable && not (entityRefInThisAssembly g.compilingFslib tcref) then + errorR(Error(FSComp.SR.tastRecursiveValuesMayNotAppearInConstructionOfType(tcref.LogicalName),m)); + mkUnionCaseFieldSet (access,c,tinst,n,e,m)))) | Expr.Op (TOp.Recd (_,tcref),tinst,args,m) -> (tcref.TrueInstanceFieldsAsRefList, args) ||> List.iter2 (fun fref arg -> @@ -5541,7 +5593,7 @@ let rec IterateRecursiveFixups g (selfv : Val option) rvs ((access : Expr),set) // NICE: it would be better to do this check in the type checker if not fspec.IsMutable && not (entityRefInThisAssembly g.compilingFslib tcref) then errorR(Error(FSComp.SR.tastRecursiveValuesMayNotBeAssignedToNonMutableField(fspec.rfield_id.idText, tcref.LogicalName),m)); - mkRecdFieldSet g (access,fref,tinst,e,m))) arg ) + mkRecdFieldSetViaExprAddr (access,fref,tinst,e,m))) arg ) | Expr.Val _ | Expr.Lambda _ | Expr.Obj _ @@ -5872,8 +5924,8 @@ let mkRecordExpr g (lnk,tcref,tinst,rfrefs:RecdFieldRef list,args,m) = //------------------------------------------------------------------------- let mkRefCell g m ty e = mkRecordExpr g (RecdExpr,g.refcell_tcr_canon,[ty],[mkRefCellContentsRef g],[e],m) -let mkRefCellGet g m ty e = mkRecdFieldGet g (e,mkRefCellContentsRef g,[ty],m) -let mkRefCellSet g m ty e1 e2 = mkRecdFieldSet g (e1,mkRefCellContentsRef g,[ty],e2,m) +let mkRefCellGet g m ty e = mkRecdFieldGetViaExprAddr (e,mkRefCellContentsRef g,[ty],m) +let mkRefCellSet g m ty e1 e2 = mkRecdFieldSetViaExprAddr (e1,mkRefCellContentsRef g,[ty],e2,m) let mkNil g m ty = mkUnionCaseExpr (g.nil_ucref,[ty],[],m) let mkCons g ty h t = mkUnionCaseExpr (g.cons_ucref,[ty],[h;t],unionRanges h.Range t.Range) @@ -7868,8 +7920,8 @@ let DetectAndOptimizeForExpression g option expr = let elemTy = destListTy g enumerableTy let guardExpr = mkNonNullTest g m nextExpr - let headOrDefaultExpr = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexHead,m) - let tailOrNullExpr = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexTail,mBody) + let headOrDefaultExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr,g.cons_ucref,[elemTy],IndexHead,m) + let tailOrNullExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr,g.cons_ucref,[elemTy],IndexTail,mBody) let bodyExpr = mkCompGenLet m elemVar headOrDefaultExpr (mkCompGenSequential mBody diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi index e4719f1b86f..ad0ce3d440e 100755 --- a/src/fsharp/TastOps.fsi +++ b/src/fsharp/TastOps.fsi @@ -188,14 +188,39 @@ val mkStaticRecdFieldGet : RecdFieldRef * TypeInst val mkStaticRecdFieldSet : RecdFieldRef * TypeInst * Expr * range -> Expr val mkStaticRecdFieldGetAddr : RecdFieldRef * TypeInst * range -> Expr val mkRecdFieldSetViaExprAddr : Expr * RecdFieldRef * TypeInst * Expr * range -> Expr -val mkUnionCaseTagGet : Expr * TyconRef * TypeInst * range -> Expr +val mkUnionCaseTagGetViaExprAddr : Expr * TyconRef * TypeInst * range -> Expr + +/// Make a 'TOp.UnionCaseProof' expression, which proves a union value is over a particular case (used only for ref-unions, not struct-unions) val mkUnionCaseProof : Expr * UnionCaseRef * TypeInst * range -> Expr -val mkUnionCaseFieldGetProven : Expr * UnionCaseRef * TypeInst * int * range -> Expr -val mkUnionCaseFieldGetUnproven : Expr * UnionCaseRef * TypeInst * int * range -> Expr -val mkExnCaseFieldGet : Expr * TyconRef * int * range -> Expr + +/// Build a 'TOp.UnionCaseFieldGet' expression for something we've already determined to be a particular union case. For ref-unions, +/// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, +/// the input should be the address of the expression. +val mkUnionCaseFieldGetProvenViaExprAddr : Expr * UnionCaseRef * TypeInst * int * range -> Expr + +/// Build a 'TOp.UnionCaseFieldGetAddr' expression for a field of a union when we've already determined the value to be a particular union case. For ref-unions, +/// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, +/// the input should be the address of the expression. +val mkUnionCaseFieldGetAddrProvenViaExprAddr : Expr * UnionCaseRef * TypeInst * int * range -> Expr + +/// Build a 'TOp.UnionCaseFieldGetAddr' expression for a field of a union when we've already determined the value to be a particular union case. For ref-unions, +/// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, +/// the input should be the address of the expression. +val mkUnionCaseFieldGetUnprovenViaExprAddr : Expr * UnionCaseRef * TypeInst * int * range -> Expr + +/// Build a 'TOp.UnionCaseFieldSet' expression. For ref-unions, the input expression has 'TType_ucase', which is +/// an F# compiler internal "type" corresponding to the union case. For struct-unions, +/// the input should be the address of the expression. val mkUnionCaseFieldSet : Expr * UnionCaseRef * TypeInst * int * Expr * range -> Expr + +/// Like mkUnionCaseFieldGetUnprovenViaExprAddr, but for struct-unions, the input should be a copy of the expression. +val mkUnionCaseFieldGetUnproven : TcGlobals -> Expr * UnionCaseRef * TypeInst * int * range -> Expr + +val mkExnCaseFieldGet : Expr * TyconRef * int * range -> Expr val mkExnCaseFieldSet : Expr * TyconRef * int * Expr * range -> Expr +val mkArrayElemAddress : TcGlobals -> ILReadonly * bool * ILArrayShape * TType * Expr * Expr * range -> Expr + //------------------------------------------------------------------------- // Compiled view of tuples //------------------------------------------------------------------------- @@ -217,6 +242,7 @@ val mkGetTupleItemN : TcGlobals -> range -> int -> ILType -> Expr -> TType -> Ex exception DefensiveCopyWarning of string * range type Mutates = DefinitelyMutates | PossiblyMutates | NeverMutates +val mkExprAddrOfExprAux : TcGlobals -> bool -> bool -> Mutates -> Expr -> ValRef option -> range -> (Val * Expr) option * Expr val mkExprAddrOfExpr : TcGlobals -> bool -> bool -> Mutates -> Expr -> ValRef option -> range -> (Expr -> Expr) * Expr //------------------------------------------------------------------------- @@ -811,7 +837,6 @@ val mkValAddr : range -> ValRef -> Expr //------------------------------------------------------------------------- val mkRecdFieldGet : TcGlobals -> Expr * RecdFieldRef * TypeInst * range -> Expr -val mkRecdFieldSet : TcGlobals -> Expr * RecdFieldRef * TypeInst * Expr * range -> Expr //------------------------------------------------------------------------- // Get the targets used in a decision graph (for reporting warnings) @@ -907,7 +932,7 @@ val ExprStats : Expr -> string // Make some common types //------------------------------------------------------------------------- -val mkNativePtrType : TcGlobals -> TType -> TType +val mkNativePtrTy : TcGlobals -> TType -> TType val mkArrayType : TcGlobals -> TType -> TType val isOptionTy : TcGlobals -> TType -> bool val destOptionTy : TcGlobals -> TType -> TType @@ -1023,7 +1048,7 @@ val TypeHasDefaultValue : TcGlobals -> range -> TType -> bool val isAbstractTycon : Tycon -> bool -val isUnionCaseAllocObservable : UnionCaseRef -> bool +val isUnionCaseRefAllocObservable : UnionCaseRef -> bool val isRecdOrUnionOrStructTyconRefAllocObservable : TcGlobals -> TyconRef -> bool val isExnAllocObservable : TyconRef -> bool val isUnionCaseFieldMutable : TcGlobals -> UnionCaseRef -> int -> bool @@ -1256,7 +1281,9 @@ val mkCompilerGeneratedAttr : TcGlobals -> int -> ILAtt //------------------------------------------------------------------------- val isByrefTy : TcGlobals -> TType -> bool +val isNativePtrTy : TcGlobals -> TType -> bool val destByrefTy : TcGlobals -> TType -> TType +val destNativePtrTy : TcGlobals -> TType -> TType val isByrefLikeTyconRef : TcGlobals -> TyconRef -> bool val isByrefLikeTy : TcGlobals -> TType -> bool diff --git a/src/fsharp/TastPickle.fs b/src/fsharp/TastPickle.fs index 2b68fbb7c57..cf37fbfc193 100755 --- a/src/fsharp/TastPickle.fs +++ b/src/fsharp/TastPickle.fs @@ -2315,6 +2315,7 @@ and p_op x st = | TOp.ValFieldGetAddr (a) -> p_byte 25 st; p_rfref a st | TOp.UInt16s arr -> p_byte 26 st; p_array p_uint16 arr st | TOp.Reraise -> p_byte 27 st + | TOp.UnionCaseFieldGetAddr (a,b) -> p_byte 28 st; p_tup2 p_ucref p_int (a,b) st | TOp.Goto _ | TOp.Label _ | TOp.Return -> failwith "unexpected backend construct in pickled TAST" #endif @@ -2376,6 +2377,9 @@ and u_op st = TOp.ValFieldGetAddr a | 26 -> TOp.UInt16s (u_array u_uint16 st) | 27 -> TOp.Reraise + | 28 -> let a = u_ucref st + let b = u_int st + TOp.UnionCaseFieldGetAddr (a,b) | _ -> ufailwith st "u_op" #if INCLUDE_METADATA_WRITER diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index a02124d5e42..6d23531256f 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -218,6 +218,7 @@ type public TcGlobals = system_Array_typ : TType system_Object_typ : TType system_IDisposable_typ : TType + system_RuntimeHelpers_typ : TType system_Value_typ : TType system_Delegate_typ : TType system_MulticastDelegate_typ : TType @@ -298,6 +299,10 @@ type public TcGlobals = attrib_PreserveSigAttribute : BuiltinAttribInfo option attrib_MethodImplAttribute : BuiltinAttribInfo attrib_ExtensionAttribute : BuiltinAttribInfo + attrib_CallerLineNumberAttribute : BuiltinAttribInfo + attrib_CallerFilePathAttribute : BuiltinAttribInfo + attrib_CallerMemberNameAttribute : BuiltinAttribInfo + tcref_System_Collections_Generic_IList : TyconRef tcref_System_Collections_Generic_IReadOnlyList : TyconRef tcref_System_Collections_Generic_ICollection : TyconRef @@ -616,6 +621,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa let sysLinq = ["System";"Linq"] let sysCollections = ["System";"Collections"] let sysGenerics = ["System";"Collections";"Generic"] + let sysCompilerServices = ["System";"Runtime";"CompilerServices"] let lazy_tcr = mkSysTyconRef sys "Lazy`1" let fslib_IEvent2_tcr = mk_MFControl_tcref fslibCcu "IEvent`2" @@ -666,7 +672,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa (* local helpers to build value infos *) let mkNullableTy ty = TType_app(nullable_tcr, [ty]) let mkByrefTy ty = TType_app(byref_tcr, [ty]) - let mkNativePtrType ty = TType_app(nativeptr_tcr, [ty]) + let mkNativePtrTy ty = TType_app(nativeptr_tcr, [ty]) let mkFunTy d r = TType_fun (d,r) let (-->) d r = mkFunTy d r let mkIteratedFunTy dl r = List.foldBack (-->) dl r @@ -845,7 +851,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa let and_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "&" ,None ,None ,[], mk_rel_sig bool_ty) let addrof_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "~&" ,None ,None ,[vara], ([[varaTy]], mkByrefTy varaTy)) - let addrof2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "~&&" ,None ,None ,[vara], ([[varaTy]], mkNativePtrType varaTy)) + let addrof2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "~&&" ,None ,None ,[vara], ([[varaTy]], mkNativePtrTy varaTy)) let and2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "&&" ,None ,None ,[], mk_rel_sig bool_ty) let or_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, "or" ,None ,Some "Or" ,[], mk_rel_sig bool_ty) let or2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "||" ,None ,None ,[], mk_rel_sig bool_ty) @@ -1099,6 +1105,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa system_Array_typ = mkSysNonGenericTy sys "Array" system_Object_typ = mkSysNonGenericTy sys "Object" system_IDisposable_typ = mkSysNonGenericTy sys "IDisposable" + system_RuntimeHelpers_typ = mkSysNonGenericTy sysCompilerServices "RuntimeHelpers" system_Value_typ = mkSysNonGenericTy sys "ValueType" system_Delegate_typ = mkSysNonGenericTy sys "Delegate" system_MulticastDelegate_typ = mkSysNonGenericTy sys "MulticastDelegate" @@ -1200,7 +1207,10 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa attrib_PreserveSigAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.PreserveSigAttribute" attrib_MethodImplAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.MethodImplAttribute" attrib_ExtensionAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.ExtensionAttribute" - + attrib_CallerLineNumberAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.CallerLineNumberAttribute" + attrib_CallerFilePathAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" + attrib_CallerMemberNameAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" + attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute" attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute" attrib_NonSerializedAttribute = if ilg.traits.NonSerializedAttributeScopeRef.IsSome then Some(mkSystemRuntimeAttrib "System.NonSerializedAttribute") else None diff --git a/src/fsharp/TraceCall.fs b/src/fsharp/TraceCall.fs deleted file mode 100644 index db24974fece..00000000000 --- a/src/fsharp/TraceCall.fs +++ /dev/null @@ -1,172 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. - -namespace Internal.Utilities.Debug - -open System -open System.IO -open System.Threading -open System.Diagnostics -open System.Runtime.InteropServices - - -module internal TraceInterop = - type MessageBeepType = - | Default = -1 - | Ok = 0x00000000 - | Error = 0x00000010 - | Question = 0x00000020 - | Warning = 0x00000030 - | Information = 0x00000040 - - [] - let MessageBeep(_mbt:MessageBeepType):bool=failwith "" - -[] -[] -type internal Trace private() = - static let mutable log = "" -#if DEBUG_WITH_TIME_AND_THREAD_INFO - static let TMinusZero = DateTime.Now -#endif - static let noopDisposable = - { new IDisposable with - member this.Dispose() = () - } - static let mutable out = Console.Out - [] [] static val mutable private indent:int - [] [] static val mutable private threadName:string - - /// Set to the semicolon-delimited names of the logging classes to be reported. - /// Use * to mean all. - static member Log - with get() = log - and set(value) = log<-value - - /// Output destination. - static member Out - with get() = out - and set(value:TextWriter) = out<-value - - /// True if the given logging class should be logged. - static member ShouldLog(loggingClass) = - let result = Trace.Log = "*" || Trace.Log.Contains(loggingClass^";") || Trace.Log.EndsWith(loggingClass,StringComparison.Ordinal) - result - - /// Description of the current thread. - static member private CurrentThreadInfo() = - if String.IsNullOrEmpty(Trace.threadName) then sprintf "(id=%d)" Thread.CurrentThread.ManagedThreadId - else sprintf "(id=%d,name=%s)" Thread.CurrentThread.ManagedThreadId Trace.threadName - - /// Report the elapsed time since start. - static member private ElapsedTime(start) = - let elapsed : TimeSpan = (DateTime.Now-start) - sprintf "%A ms" elapsed.TotalMilliseconds - - /// Get a string with spaces for indention. - static member private IndentSpaces() = new string(' ', Trace.indent) - - /// Log a message. - static member private LogMessage(msg:string) = - Trace.Out.Write(sprintf "%s%s" (Trace.IndentSpaces()) msg) - Trace.Out.Flush() - if Trace.Out<>Console.Out then - // Always log to console. - Console.Out.Write(sprintf "%s%s" (Trace.IndentSpaces()) msg) - - /// Name the current thread. - static member private NameCurrentThread(threadName) = - match threadName with - | Some(threadName)-> - let current = Trace.threadName - if String.IsNullOrEmpty(current) then Trace.threadName <- threadName - else if not(current.Contains(threadName)) then Trace.threadName <- current^","^threadName - | None -> () - - /// Base implementation of the call function. - static member private CallImpl(loggingClass,functionName,descriptionFunc,threadName:string option) : IDisposable = - #if DEBUG - if Trace.ShouldLog(loggingClass) then - Trace.NameCurrentThread(threadName) - - let description = try descriptionFunc() with e->"No description because of exception" - -#if DEBUG_WITH_TIME_AND_THREAD_INFO - let threadInfo = Trace.CurrentThreadInfo() - let indent = Trace.IndentSpaces() - let start = DateTime.Now - Trace.LogMessage(sprintf "Entering %s(%s) %s t-plus %fms %s\n" - functionName - loggingClass - threadInfo - (start-TMinusZero).TotalMilliseconds - description) -#else - Trace.LogMessage(sprintf "Entering %s(%s) %s\n" - functionName - loggingClass - description) -#endif - Trace.indent<-Trace.indent+1 - - {new IDisposable with - member d.Dispose() = - Trace.indent<-Trace.indent-1 -#if DEBUG_WITH_TIME_AND_THREAD_INFO - Trace.LogMessage(sprintf "Exitting %s %s %s\n" - functionName - threadInfo - (Trace.ElapsedTime(start)))} -#else - Trace.LogMessage(sprintf "Exiting %s\n" - functionName)} -#endif - else - noopDisposable : IDisposable - #else - ignore(loggingClass,functionName,descriptionFunc,threadName) - noopDisposable : IDisposable - #endif - - /// Log a method as it's called. - static member Call(loggingClass:string,functionName:string,descriptionFunc:unit->string) = Trace.CallImpl(loggingClass,functionName,descriptionFunc,None) - /// Log a method as it's called. Expected always to be called on the same thread which will be named 'threadName'. - static member CallByThreadNamed(loggingClass:string,functionName:string,threadName:string,descriptionFunc:unit->string) = Trace.CallImpl(loggingClass,functionName,descriptionFunc,Some(threadName)) - /// Log a message by logging class. - static member PrintLine(loggingClass:string, messageFunc:unit->string) = - #if DEBUG - if Trace.ShouldLog(loggingClass) then - let message = try messageFunc() with _-> "No message because of exception.\n" - Trace.LogMessage(sprintf "%s%s" message System.Environment.NewLine) - #else - ignore(loggingClass,messageFunc) - #endif - - /// Log a message by logging class. - static member Print(loggingClass:string, messageFunc:unit->string) = - #if DEBUG - if Trace.ShouldLog(loggingClass) then - let message = try messageFunc() with _-> "No message because of exception.\n" - Trace.LogMessage(message) - #else - ignore(loggingClass,messageFunc) - #endif - - /// Make a beep when the given loggingClass is matched. - static member private BeepHelper(loggingClass,beeptype) = - #if DEBUG - if Trace.ShouldLog(loggingClass) then - TraceInterop.MessageBeep(beeptype) |> ignore - #else - ignore(loggingClass,beeptype) - #endif - - /// Make the "OK" sound when the given loggingClass is matched. - static member BeepOk(loggingClass:string) = Trace.BeepHelper(loggingClass,TraceInterop.MessageBeepType.Ok) - - /// Make the "Error" sound when the given loggingClass is matched. - static member BeepError(loggingClass:string) = Trace.BeepHelper(loggingClass,TraceInterop.MessageBeepType.Error) - - /// Make the default sound when the given loggingClass is matched. - static member Beep(loggingClass:string) = Trace.BeepHelper(loggingClass,TraceInterop.MessageBeepType.Default) - - diff --git a/src/fsharp/TraceCall.fsi b/src/fsharp/TraceCall.fsi deleted file mode 100644 index 609d1d1bb0e..00000000000 --- a/src/fsharp/TraceCall.fsi +++ /dev/null @@ -1,25 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. - -namespace Internal.Utilities.Debug - module internal TraceInterop = - type MessageBeepType = - | Default = -1 - | Ok = 0 - | Error = 16 - | Question = 32 - | Warning = 48 - | Information = 64 - val MessageBeep : MessageBeepType -> bool - [] - type internal Trace = - static member Beep : loggingClass:string -> unit - static member BeepError : loggingClass:string -> unit - static member BeepOk : loggingClass:string -> unit - static member Call : loggingClass:string * functionName:string * descriptionFunc:(unit->string) -> System.IDisposable - static member CallByThreadNamed : loggingClass:string * functionName:string * threadName:string * descriptionFunc:(unit->string) -> System.IDisposable - static member Print : loggingClass:string * messageFunc:(unit->string) -> unit - static member PrintLine : loggingClass:string * messageFunc:(unit->string) -> unit - static member ShouldLog : loggingClass:string -> bool - static member Log : string with get, set - static member Out : System.IO.TextWriter with get, set - diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index c8cfc054800..c77de8b545f 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -277,6 +277,8 @@ type TcEnv = // Information to enforce special restrictions on valid expressions // for .NET constructors. eCtorInfo : CtorInfo option + + eCallerMemberName : string option } member tenv.DisplayEnv = tenv.eNameResEnv.DisplayEnv member tenv.NameEnv = tenv.eNameResEnv @@ -298,7 +300,8 @@ let emptyTcEnv g = eContextInfo=ContextInfo.NoContext eModuleOrNamespaceTypeAccumulator= ref (NewEmptyModuleOrNamespaceType Namespace) eFamilyType=None - eCtorInfo=None } + eCtorInfo=None + eCallerMemberName=None} //------------------------------------------------------------------------- // Helpers related to determining if we're in a constructor and/or a class @@ -1048,7 +1051,7 @@ type DeclKind = | IntrinsicExtensionBinding /// Extensions to a type in a different assembly | ExtrinsicExtensionBinding - | ClassLetBinding + | ClassLetBinding of (* isStatic *) bool | ObjectExpressionOverrideBinding | ExpressionBinding @@ -1057,7 +1060,7 @@ type DeclKind = | ModuleOrMemberBinding -> true | IntrinsicExtensionBinding -> true | ExtrinsicExtensionBinding -> true - | ClassLetBinding -> false + | ClassLetBinding _ -> false | ObjectExpressionOverrideBinding -> false | ExpressionBinding -> false @@ -1068,7 +1071,7 @@ type DeclKind = | ModuleOrMemberBinding -> true | IntrinsicExtensionBinding -> true | ExtrinsicExtensionBinding -> true - | ClassLetBinding -> true + | ClassLetBinding _ -> true | ObjectExpressionOverrideBinding -> false | ExpressionBinding -> false @@ -1088,7 +1091,7 @@ type DeclKind = | None -> AttributeTargets.Field ||| AttributeTargets.Method ||| AttributeTargets.Property | IntrinsicExtensionBinding -> AttributeTargets.Method ||| AttributeTargets.Property | ExtrinsicExtensionBinding -> AttributeTargets.Method ||| AttributeTargets.Property - | ClassLetBinding -> AttributeTargets.Field ||| AttributeTargets.Method + | ClassLetBinding _ -> AttributeTargets.Field ||| AttributeTargets.Method | ExpressionBinding -> enum 0 // indicates attributes not allowed on expression 'let' bindings // Note: now always true @@ -1097,7 +1100,7 @@ type DeclKind = | ModuleOrMemberBinding -> true | IntrinsicExtensionBinding -> true | ExtrinsicExtensionBinding -> true - | ClassLetBinding -> true + | ClassLetBinding _ -> true | ObjectExpressionOverrideBinding -> true | ExpressionBinding -> true @@ -1106,7 +1109,7 @@ type DeclKind = | ModuleOrMemberBinding -> true | IntrinsicExtensionBinding -> true | ExtrinsicExtensionBinding -> true - | ClassLetBinding -> true + | ClassLetBinding _ -> true | ObjectExpressionOverrideBinding -> true | ExpressionBinding -> false @@ -1115,7 +1118,7 @@ type DeclKind = | ModuleOrMemberBinding -> OverridesOK | IntrinsicExtensionBinding -> WarnOnOverrides | ExtrinsicExtensionBinding -> ErrorOnOverrides - | ClassLetBinding -> ErrorOnOverrides + | ClassLetBinding _ -> ErrorOnOverrides | ObjectExpressionOverrideBinding -> OverridesOK | ExpressionBinding -> ErrorOnOverrides @@ -1196,7 +1199,6 @@ type TcPatPhase2Input = type CheckedBindingInfo = | CheckedBindingInfo of ValInline * - bool * (* immutable? *) Tast.Attribs * XmlDoc * (TcPatPhase2Input -> PatternMatchCompilation.Pattern) * @@ -1207,10 +1209,11 @@ type CheckedBindingInfo = TType * range * SequencePointInfoForBinding * - bool * (* compiler generated? *) - Const option (* literal value? *) - member x.Expr = let (CheckedBindingInfo(_,_,_,_,_,_,_,expr,_,_,_,_,_,_)) = x in expr - member x.SeqPoint = let (CheckedBindingInfo(_,_,_,_,_,_,_,_,_,_,_,spBind,_,_)) = x in spBind + bool * // compiler generated? + Const option * // literal value? + bool // fixed? + member x.Expr = let (CheckedBindingInfo(_,_,_,_,_,_,expr,_,_,_,_,_,_,_)) = x in expr + member x.SeqPoint = let (CheckedBindingInfo(_,_,_,_,_,_,_,_,_,_,spBind,_,_,_)) = x in spBind //------------------------------------------------------------------------- // Helpers related to type schemes @@ -2037,7 +2040,7 @@ module GeneralizationHelpers = | Expr.Op(op,_,args,_) -> match op with | TOp.Tuple -> true - | TOp.UnionCase uc -> not (isUnionCaseAllocObservable uc) + | TOp.UnionCase uc -> not (isUnionCaseRefAllocObservable uc) | TOp.Recd(ctorInfo,tcref) -> match ctorInfo with | RecdExpr -> not (isRecdOrUnionOrStructTyconRefAllocObservable g tcref) @@ -2174,7 +2177,7 @@ module GeneralizationHelpers = let ComputeAndGeneralizeGenericTypars (cenv, denv:DisplayEnv, m, - immut, + canGeneralize, freeInEnv:FreeTypars, canInferTypars, genConstrainedTyparFlag, @@ -2187,7 +2190,7 @@ module GeneralizationHelpers = let allDeclaredTypars = NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g allDeclaredTypars let typarsToAttemptToGeneralize = - if immut && (match exprOpt with None -> true | Some e -> IsGeneralizableValue cenv.g e) + if canGeneralize && (match exprOpt with None -> true | Some e -> IsGeneralizableValue cenv.g e) then (ListSet.unionFavourLeft typarEq allDeclaredTypars maxInferredTypars) else allDeclaredTypars @@ -2945,6 +2948,17 @@ let BuildDisposableCleanup cenv env m (v:Val) = let inpe = mkCoerceExpr(exprForVal v.Range v,cenv.g.obj_ty,m,v.Type) mkIsInstConditional cenv.g m cenv.g.system_IDisposable_typ inpe disposeObjVar disposeExpr (mkUnit cenv.g m) +/// Build call to get_OffsetToStringData as part of 'fixed' +let BuildOffsetToStringData cenv env m = + let ad = env.eAccessRights + let offsetToStringDataMethod = + match TryFindIntrinsicOrExtensionMethInfo cenv env m ad "get_OffsetToStringData" cenv.g.system_RuntimeHelpers_typ with + | [x] -> x + | _ -> error(Error(FSComp.SR.tcCouldNotFindOffsetToStringData(),m)) + + let offsetExpr,_ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false offsetToStringDataMethod NormalValUse [] [] [] + offsetExpr + let BuildILFieldGet g amap m objExpr (finfo:ILFieldInfo) = let fref = finfo.ILFieldRef let isValueType = finfo.IsValueType @@ -3000,7 +3014,8 @@ let BuildRecdFieldSet g m objExpr (rfinfo:RecdFieldInfo) argExpr = let tgty = rfinfo.EnclosingType let valu = isStructTy g tgty let objExpr = if valu then objExpr else mkCoerceExpr(objExpr,tgty,m,tyOfExpr g objExpr) - mkRecdFieldSet g (objExpr,rfinfo.RecdFieldRef,rfinfo.TypeInst,argExpr,m) + let wrap,objExpr = mkExprAddrOfExpr g valu false DefinitelyMutates objExpr None m + wrap (mkRecdFieldSetViaExprAddr (objExpr,rfinfo.RecdFieldRef,rfinfo.TypeInst,argExpr,m) ) //------------------------------------------------------------------------- @@ -3448,7 +3463,7 @@ module MutRecShapes = | MutRecShape.Tycon a -> MutRecShape.Tycon (f2 parent a) | MutRecShape.Lets b -> MutRecShape.Lets (f3 parent b) | MutRecShape.Module (c,d) -> - let c2, parent2 = f1 parent c + let c2, parent2 = f1 parent c d MutRecShape.Module (c2, mapWithParent parent2 f1 f2 f3 d)) let rec computeEnvs f1 f2 (env: 'Env) xs = @@ -3774,7 +3789,7 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr:Expr) = let thisTy = tyOfExpr g recdExpr let thisExpr = mkGetArg0 m thisTy let thisTyInst = argsOfAppTy g thisTy - let setExpr = mkRecdFieldSet g (thisExpr, rfref, thisTyInst, mkOne g m, m) + let setExpr = mkRecdFieldSetViaExprAddr (thisExpr, rfref, thisTyInst, mkOne g m, m) Expr.Sequential(recdExpr,setExpr,ThenDoSeq,SuppressSequencePointOnExprOfSequential,m) recdExpr @@ -5499,6 +5514,9 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = | SynExpr.Assert (x,m) -> TcAssertExpr cenv overallTy env m tpenv x + | SynExpr.Fixed (_,m) -> + error(Error(FSComp.SR.tcFixedNotAllowed(),m)) + // e : ty | SynExpr.Typed (e,cty,m) -> let tgty,tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty @@ -5823,7 +5841,7 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = | SynExpr.LibraryOnlyUnionCaseFieldGet (e1,c,n,m) -> let e1',ty1,tpenv = TcExprOfUnknownType cenv env tpenv e1 let mkf,ty2 = TcUnionCaseOrExnField cenv env ty1 m c n - ((fun (a,b) n -> mkUnionCaseFieldGetUnproven(e1',a,b,n,m)), + ((fun (a,b) n -> mkUnionCaseFieldGetUnproven cenv.g (e1',a,b,n,m)), (fun a n -> mkExnCaseFieldGet(e1',a,n,m))) UnifyTypes cenv env m overallTy ty2 mkf n,tpenv @@ -6109,18 +6127,19 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = (fname,fieldExpr),tpenv) // Add rebindings for unbound field when an "old value" is available - let oldFldsList = + // Effect order: mutable fields may get modified by other bindings... + let oldFldsList, wrap = match optOrigExpr with - | None -> [] - | Some (_,_,oldve') -> - // When we have an "old" value, append bindings for the unbound fields. - // Effect order - mutable fields may get modified by other bindings... - let fieldNameUnbound nom = List.forall (fun (name,_) -> name <> nom) fldsList - fspecs - |> List.choose (fun rfld -> + | None -> [], id + | Some (_,_,oldve) -> + let wrap,oldveaddr = mkExprAddrOfExpr cenv.g tycon.IsStructOrEnumTycon false NeverMutates oldve None m + let fieldNameUnbound nom = List.forall (fun (name,_) -> name <> nom) fldsList + let flds = + fspecs |> List.choose (fun rfld -> if fieldNameUnbound rfld.Name && not rfld.IsZeroInit - then Some(rfld.Name, mkRecdFieldGet cenv.g (oldve',tcref.MakeNestedRecdFieldRef rfld,tinst,m)) + then Some(rfld.Name, mkRecdFieldGetViaExprAddr (oldveaddr,tcref.MakeNestedRecdFieldRef rfld,tinst,m)) else None) + flds, wrap let fldsList = fldsList @ oldFldsList @@ -6153,7 +6172,7 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = let args = List.map snd fldsList - let expr = mkRecordExpr cenv.g (GetRecdInfo env, tcref, tinst, rfrefs, args, m) + let expr = wrap (mkRecordExpr cenv.g (GetRecdInfo env, tcref, tinst, rfrefs, args, m)) let expr = match optOrigExpr with @@ -6161,10 +6180,10 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = // '{ recd fields }'. // expr - | Some (old',oldv',_) -> + | Some (old,oldv,_) -> // '{ recd with fields }'. // Assign the first object to a tmp and then construct - mkCompGenLet m oldv' old' expr + mkCompGenLet m oldv old expr expr, tpenv @@ -6262,9 +6281,9 @@ and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo,bind) = | _ -> implty --> NewInferenceType () - let (CheckedBindingInfo(inlineFlag,immut,bindingAttribs,_,_,ExplicitTyparInfo(_,declaredTypars,_),nameToPrelimValSchemeMap,rhsExpr,_,_,m,_,_,_),tpenv) = + let (CheckedBindingInfo(inlineFlag,bindingAttribs,_,_,ExplicitTyparInfo(_,declaredTypars,_),nameToPrelimValSchemeMap,rhsExpr,_,_,m,_,_,_,_),tpenv) = let flex, tpenv = TcNonrecBindingTyparDecls cenv env tpenv bind - TcNormalizedBinding ObjectExpressionOverrideBinding cenv env tpenv bindingTy None NoSafeInitInfo ([],flex) bind + TcNormalizedBinding ObjectExpressionOverrideBinding cenv env tpenv false bindingTy None NoSafeInitInfo ([],flex) bind // 4c. generalize the binding - only relevant when implementing a generic virtual method @@ -6283,7 +6302,7 @@ and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo,bind) = let freeInEnv = GeneralizationHelpers.ComputeUngeneralizableTypars env - let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv,m,immut,freeInEnv,false,CanGeneralizeConstrainedTypars,inlineFlag,Some(rhsExpr),declaredTypars,[],bindingTy,false) + let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv,m,true,freeInEnv,false,CanGeneralizeConstrainedTypars,inlineFlag,Some(rhsExpr),declaredTypars,[],bindingTy,false) let declaredTypars = ChooseCanonicalDeclaredTyparsAfterInference cenv.g env.DisplayEnv declaredTypars m let generalizedTypars = PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars @@ -6603,13 +6622,13 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr let optOrigExpr,tpenv = match optOrigExpr with | None -> None, tpenv - | Some (e, _) -> + | Some (origExpr, _) -> match inherits with | Some (_,_,mInherits, _, _) -> error(Error(FSComp.SR.tcInvalidRecordConstruction(),mInherits)) | None -> - let e',tpenv = TcExpr cenv overallTy env tpenv e - let v',ve' = mkCompGenLocal mWholeExpr "inputRecord" overallTy - Some (e',v',ve'), tpenv + let olde,tpenv = TcExpr cenv overallTy env tpenv origExpr + let oldv,oldve = mkCompGenLocal mWholeExpr "inputRecord" overallTy + Some (olde,oldv,oldve), tpenv let fldsList = let flds = @@ -8902,8 +8921,8 @@ and TcMethodApplication let denv = env.DisplayEnv - let isSimpleFormalArg (isParamArrayArg, isOutArg, optArgInfo: OptionalArgInfo, _reflArgInfo: ReflectedArgInfo) = - not isParamArrayArg && not isOutArg && not optArgInfo.IsOptional + let isSimpleFormalArg (isParamArrayArg, isOutArg, optArgInfo: OptionalArgInfo, callerInfoInfo: CallerInfoInfo, _reflArgInfo: ReflectedArgInfo) = + not isParamArrayArg && not isOutArg && not optArgInfo.IsOptional && callerInfoInfo = NoCallerInfo let callerObjArgTys = objArgs |> List.map (tyOfExpr cenv.g) @@ -9260,7 +9279,7 @@ and TcMethodApplication if HasHeadType cenv.g cenv.g.tcref_System_Collections_Generic_Dictionary finalCalledMethInfo.EnclosingType && finalCalledMethInfo.IsConstructor && not (finalCalledMethInfo.GetParamDatas(cenv.amap, mItem, finalCalledMeth.CallerTyArgs) - |> List.existsSquared (fun (ParamData(_,_,_,_,_,ty)) -> + |> List.existsSquared (fun (ParamData(_,_,_,_,_,_,ty)) -> HasHeadType cenv.g cenv.g.tcref_System_Collections_Generic_IEqualityComparer ty)) then match argsOfAppTy cenv.g finalCalledMethInfo.EnclosingType with @@ -9389,7 +9408,16 @@ and TcMethodApplication | ByrefTy cenv.g inst -> build inst (PassByRef(inst, currDfltVal)) | _ -> - emptyPreBinder,Expr.Const(TcFieldInit mMethExpr fieldInit,mMethExpr,currCalledArgTy) + match calledArg.CallerInfoInfo, env.eCallerMemberName with + | CallerLineNumber, _ when typeEquiv cenv.g currCalledArgTy cenv.g.int_ty -> + emptyPreBinder,Expr.Const(Const.Int32(mMethExpr.StartLine), mMethExpr, currCalledArgTy) + | CallerFilePath, _ when typeEquiv cenv.g currCalledArgTy cenv.g.string_ty -> + emptyPreBinder,Expr.Const(Const.String(System.IO.Path.GetFullPath(mMethExpr.FileName)), mMethExpr, currCalledArgTy) + | CallerMemberName, Some(callerName) when (typeEquiv cenv.g currCalledArgTy cenv.g.string_ty) -> + emptyPreBinder,Expr.Const(Const.String(callerName), mMethExpr, currCalledArgTy) + | _ -> + emptyPreBinder,Expr.Const(TcFieldInit mMethExpr fieldInit,mMethExpr,currCalledArgTy) + | WrapperForIDispatch -> match cenv.g.ilg.traits.SystemRuntimeInteropServicesScopeRef.Value with | None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr)) @@ -9411,13 +9439,25 @@ and TcMethodApplication let wrapper2,rhs = build currCalledArgTy dfltVal2 (wrapper2 >> mkCompGenLet mMethExpr v rhs), mkValAddr mMethExpr (mkLocalValRef v) build calledArgTy dfltVal - | CalleeSide -> + | CalleeSide -> let calledNonOptTy = if isOptionTy cenv.g calledArgTy then destOptionTy cenv.g calledArgTy else calledArgTy // should be unreachable - emptyPreBinder,mkUnionCaseExpr(mkNoneCase cenv.g,[calledNonOptTy],[],mMethExpr) + + match calledArg.CallerInfoInfo, env.eCallerMemberName with + | CallerLineNumber, _ when typeEquiv cenv.g calledNonOptTy cenv.g.int_ty -> + let lineExpr = Expr.Const(Const.Int32(mMethExpr.StartLine), mMethExpr, calledNonOptTy) + emptyPreBinder,mkUnionCaseExpr(mkSomeCase cenv.g,[calledNonOptTy],[lineExpr],mMethExpr) + | CallerFilePath, _ when typeEquiv cenv.g calledNonOptTy cenv.g.string_ty -> + let filePathExpr = Expr.Const(Const.String(System.IO.Path.GetFullPath(mMethExpr.FileName)), mMethExpr, calledNonOptTy) + emptyPreBinder,mkUnionCaseExpr(mkSomeCase cenv.g,[calledNonOptTy],[filePathExpr],mMethExpr) + | CallerMemberName, Some(callerName) when typeEquiv cenv.g calledNonOptTy cenv.g.string_ty -> + let memberNameExpr = Expr.Const(Const.String(callerName), mMethExpr, calledNonOptTy) + emptyPreBinder,mkUnionCaseExpr(mkSomeCase cenv.g,[calledNonOptTy],[memberNameExpr],mMethExpr) + | _ -> + emptyPreBinder,mkUnionCaseExpr(mkNoneCase cenv.g,[calledNonOptTy],[],mMethExpr) // Combine the variable allocators (if any) let wrapper = (wrapper >> wrapper2) @@ -9427,18 +9467,19 @@ and TcMethodApplication // Handle optional arguments let wrapOptionalArg (assignedArg: AssignedCalledArg<_>) = - let (CallerArg(callerArgTy,m,isOptCallerArg,expr)) = assignedArg.CallerArg + let (CallerArg(callerArgTy,m,isOptCallerArg,expr)) = assignedArg.CallerArg match assignedArg.CalledArg.OptArgInfo with | NotOptional -> if isOptCallerArg then errorR(Error(FSComp.SR.tcFormalArgumentIsNotOptional(),m)) assignedArg - | _ -> let expr = match assignedArg.CalledArg.OptArgInfo with | CallerSide _ -> if isOptCallerArg then - mkUnionCaseFieldGetUnproven(expr,mkSomeCase cenv.g,[destOptionTy cenv.g callerArgTy],0,m) + // STRUCT OPTIONS: if we allow struct options as optional arguments then we should take + // the address correctly. + mkUnionCaseFieldGetUnprovenViaExprAddr (expr,mkSomeCase cenv.g,[destOptionTy cenv.g callerArgTy],0,m) else expr | CalleeSide -> @@ -9727,8 +9768,7 @@ and TcLinearLetExprs bodyChecker cenv env overallTy builder tpenv (processUseBin // TcLinearLetExprs processes multiple 'let' bindings in a tail recursive way // We process one binding, then look for additional linear bindings and accumulate the builder continuation. // Don't processes 'use' bindings (e.g. in sequence expressions) unless directed to. - let mkf,envinner,tpenv = - TcLetBinding cenv isUse env ExprContainerInfo ExpressionBinding tpenv (binds,m,body.Range) + let mkf,envinner,tpenv = TcLetBinding cenv isUse env ExprContainerInfo ExpressionBinding tpenv (binds,m,body.Range) let builder' x = builder (mkf x) match body with | SynExpr.LetOrUse (isRec',isUse',binds',bodyExpr,m') when (not isUse' || processUseBindings) -> @@ -9772,18 +9812,118 @@ and TcStaticOptimizationConstraint cenv env tpenv c = let tp',tpenv = TcTypar cenv env NewTyparsOK tpenv tp TTyconIsStruct(mkTyparTy tp'),tpenv +/// Emit a conv.i instruction +and mkConvToNativeInt g e m = Expr.Op (TOp.ILAsm ([ AI_conv ILBasicType.DT_I], [ g.nativeint_ty ]),[],[e],m) + +/// Fix up the r.h.s. of a 'use x = fixed expr' +and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBinding) = + warning(PossibleUnverifiableCode(mBinding)) + match overallExprTy with + | ty when isByrefTy cenv.g ty -> + let okByRef = + match stripExpr fixedExpr with + | Expr.Op (op,tyargs,args,_) -> + match op,tyargs,args with + | TOp.ValFieldGetAddr rfref,_,[_] -> not rfref.Tycon.IsStructOrEnumTycon + | TOp.ILAsm ([ I_ldflda (fspec)],_),_,_ -> fspec.EnclosingType.Boxity = ILBoxity.AsObject + | TOp.ILAsm ([ I_ldelema _],_),_,_ -> true + | TOp.RefAddrGet _,_,_ -> true + | _ -> false + | _ -> false + if not okByRef then + error(Error(FSComp.SR.tcFixedNotAllowed(),mBinding)) + + let elemTy = destByrefTy cenv.g overallExprTy + UnifyTypes cenv env mBinding (mkNativePtrTy cenv.g elemTy) overallPatTy + mkCompGenLetIn mBinding "pinnedByref" ty fixedExpr (fun (v,ve) -> + v.SetIsFixed() + mkConvToNativeInt cenv.g ve mBinding) + + | ty when isStringTy cenv.g ty -> + let charPtrTy = mkNativePtrTy cenv.g cenv.g.char_ty + UnifyTypes cenv env mBinding charPtrTy overallPatTy + // + // let ptr : nativeptr = + // let pinned s = str + // (nativeptr)s + get_OffsettoStringData() + + mkCompGenLetIn mBinding "pinnedString" cenv.g.string_ty fixedExpr (fun (v,ve) -> + v.SetIsFixed() + let addrOffset = BuildOffsetToStringData cenv env mBinding + let stringAsNativeInt = mkConvToNativeInt cenv.g ve mBinding + let plusOffset = Expr.Op (TOp.ILAsm ([ AI_add ], [ cenv.g.nativeint_ty ]),[],[stringAsNativeInt; addrOffset],mBinding) + // check for non-null + mkNullTest cenv.g mBinding ve plusOffset ve) + + | ty when isArray1DTy cenv.g ty -> + let elemTy = destArrayTy cenv.g overallExprTy + let elemPtrTy = mkNativePtrTy cenv.g elemTy + UnifyTypes cenv env mBinding elemPtrTy overallPatTy + + // let ptr : nativeptr = + // let tmpArray : elem[] = arr + // if nonNull tmpArray then + // if tmpArray.Length <> 0 then + // let pinned tmpArrayByref : byref = &arr.[0] + // (nativeint) tmpArrayByref + // else + // (nativeint) 0 + // else + // (nativeint) 0 + // + mkCompGenLetIn mBinding "tmpArray" overallExprTy fixedExpr (fun (_,ve) -> + // This is &arr.[0] + let elemZeroAddress = mkArrayElemAddress cenv.g (ILReadonly.NormalAddress,false,ILArrayShape.SingleDimensional,elemTy,ve,mkInt32 cenv.g mBinding 0,mBinding) + // check for non-null and non-empty + let zero = mkConvToNativeInt cenv.g (mkInt32 cenv.g mBinding 0) mBinding + // This is arr.Length + let arrayLengthExpr = mkCallArrayLength cenv.g mBinding elemTy ve + mkNullTest cenv.g mBinding ve + (mkNullTest cenv.g mBinding arrayLengthExpr + (mkCompGenLetIn mBinding "pinnedByref" (mkByrefTy cenv.g elemTy) elemZeroAddress (fun (v,ve) -> + v.SetIsFixed() + (mkConvToNativeInt cenv.g ve mBinding))) + zero) + zero) + + | _ -> error(Error(FSComp.SR.tcFixedNotAllowed(),mBinding)) + + /// Binding checking code, for all bindings including let bindings, let-rec bindings, member bindings and object-expression bindings and -and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt safeInitInfo (enclosingDeclaredTypars,(ExplicitTyparInfo(_,declaredTypars,_) as flex)) bind = +and TcNormalizedBinding declKind (cenv:cenv) env tpenv isUse overallTy safeThisValOpt safeInitInfo (enclosingDeclaredTypars,(ExplicitTyparInfo(_,declaredTypars,_) as flex)) bind = let envinner = AddDeclaredTypars NoCheckForDuplicateTypars (enclosingDeclaredTypars@declaredTypars) env match bind with | NormalizedBinding(vis,bkind,isInline,isMutable,attrs,doc,_,valSynData,pat,NormalizedBindingRhs(spatsL,rtyOpt,rhsExpr),mBinding,spBind) -> - let (SynValData(memberFlagsOpt,valSynInfo,_)) = valSynData + let callerName = + match declKind, bkind, pat with + | ExpressionBinding, _, _ -> envinner.eCallerMemberName + | _, _, SynPat.Named(_,name,_,_,_) -> + match memberFlagsOpt with + | Some(memberFlags) -> + match memberFlags.MemberKind with + | MemberKind.PropertyGet | MemberKind.PropertySet | MemberKind.PropertyGetSet -> Some(name.idText.Substring(4)) + | MemberKind.ClassConstructor -> Some(".ctor") + | MemberKind.Constructor -> Some(".ctor") + | _ -> Some(name.idText) + | _ -> Some(name.idText) + | ClassLetBinding(false), DoBinding, _ -> Some(".ctor") + | ClassLetBinding(true), DoBinding, _ -> Some(".cctor") + | ModuleOrMemberBinding, StandaloneExpression, _ -> Some(".cctor") + | _, _, _ -> envinner.eCallerMemberName + + let envinner = {envinner with eCallerMemberName = callerName } + let attrTgt = DeclKind.AllowedAttribTargets memberFlagsOpt declKind + let isFixed,rhsExpr,overallPatTy,overallExprTy = + match rhsExpr with + | SynExpr.Fixed (e,_) -> true, e, NewInferenceType(), overallTy + | e -> false, e, overallTy, overallTy + // Check the attributes of the binding, parameters or return value let TcAttrs tgt attrs = let attrs = TcAttributes cenv envinner tgt attrs @@ -9798,6 +9938,7 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt let argAttribs = spatsL |> List.map (SynInfo.InferSynArgInfoFromSimplePats >> List.map (SynInfo.AttribsOfArgData >> TcAttrs AttributeTargets.Parameter)) + let retAttribs = match rtyOpt with | Some (SynBindingReturnInfo(_,_,retAttrs)) -> TcAttrs AttributeTargets.ReturnValue retAttrs @@ -9812,11 +9953,20 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt if isThreadStatic then errorR(DeprecatedThreadStaticBindingWarning(mBinding)) if isVolatile then - if declKind <> ClassLetBinding then - errorR(Error(FSComp.SR.tcVolatileOnlyOnClassLetBindings(),mBinding)) + match declKind with + | ClassLetBinding(_) -> () + | _ -> errorR(Error(FSComp.SR.tcVolatileOnlyOnClassLetBindings(),mBinding)) + if (not isMutable || isThreadStatic) then errorR(Error(FSComp.SR.tcVolatileFieldsMustBeMutable(),mBinding)) + if isFixed then + if declKind <> ExpressionBinding || isInline || isMutable then + errorR(Error(FSComp.SR.tcFixedNotAllowed(),mBinding)) + + if isUse && isMutable then + warning(Error(FSComp.SR.tcUseMayNotBeMutable(),mBinding)) + if HasFSharpAttributeOpt cenv.g cenv.g.attrib_DllImportAttribute valAttribs then if not declKind.CanBeDllImport || (match memberFlagsOpt with Some memberFlags -> memberFlags.IsInstance | _ -> false) then errorR(Error(FSComp.SR.tcDllImportNotAllowed(),mBinding)) @@ -9828,12 +9978,16 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt if isSome(memberFlagsOpt) then errorR(Error(FSComp.SR.tcEntryPointAttributeRequiresFunctionInModule(),mBinding)) else - UnifyTypes cenv env mBinding overallTy (mkArrayType cenv.g cenv.g.string_ty --> cenv.g.int_ty) + UnifyTypes cenv env mBinding overallPatTy (mkArrayType cenv.g cenv.g.string_ty --> cenv.g.int_ty) if isMutable && isInline then errorR(Error(FSComp.SR.tcMutableValuesCannotBeInline(),mBinding)) + if isMutable && nonNil declaredTypars then errorR(Error(FSComp.SR.tcMutableValuesMayNotHaveGenericParameters(),mBinding)) + let flex = if isMutable then dontInferTypars else flex + if isMutable && nonNil spatsL then errorR(Error(FSComp.SR.tcMutableValuesSyntax(),mBinding)) + let isInline = if isInline && isNil spatsL && isNil declaredTypars then errorR(Error(FSComp.SR.tcOnlyFunctionsCanBeInline(),mBinding)) @@ -9848,7 +10002,7 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt // Check the pattern of the l.h.s. of the binding let tcPatPhase2,(tpenv,nameToPrelimValSchemeMap,_) = - TcPat AllIdsOK cenv envinner (Some(partialValReprInfo)) (inlineFlag,flex,argAndRetAttribs,isMutable,vis,compgen) (tpenv,NameMap.empty,Set.empty) overallTy pat + TcPat AllIdsOK cenv envinner (Some(partialValReprInfo)) (inlineFlag,flex,argAndRetAttribs,isMutable,vis,compgen) (tpenv,NameMap.empty,Set.empty) overallPatTy pat // Add active pattern result names to the environment @@ -9879,22 +10033,26 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt // If binding a ctor then set the ugly counter that permits us to write ctor expressions on the r.h.s. let isCtor = (match memberFlagsOpt with Some memberFlags -> memberFlags.MemberKind = MemberKind.Constructor | _ -> false) - let tc = - if isCtor then TcExprThatIsCtorBody (safeThisValOpt, safeInitInfo) - else TcExprThatCantBeCtorBody - // At each module binding, dive into the expression to check for syntax errors and suppress them if they show. // Don't do this for lambdas, because we always check for suppression for all lambda bodies in TcIteratedLambdas - let rhsExpr',tpenv = + let rhsExprChecked,tpenv = let atTopNonLambdaDefn = DeclKind.IsModuleOrMemberOrExtensionBinding declKind && (match rhsExpr with SynExpr.Lambda _ -> false | _ -> true) && synExprContainsError rhsExpr + conditionallySuppressErrorReporting atTopNonLambdaDefn (fun () -> - tc cenv overallTy envinner tpenv rhsExpr) + + if isCtor then TcExprThatIsCtorBody (safeThisValOpt, safeInitInfo) cenv overallExprTy envinner tpenv rhsExpr + else TcExprThatCantBeCtorBody cenv overallExprTy envinner tpenv rhsExpr) if bkind = StandaloneExpression && not cenv.isScript then - UnifyUnitType cenv env.DisplayEnv mBinding overallTy (Some rhsExpr') |> ignore + UnifyUnitType cenv env.DisplayEnv mBinding overallPatTy (Some rhsExprChecked) |> ignore + + // Fix up the r.h.s. expression for 'fixed' + let rhsExprChecked = + if isFixed then TcAndBuildFixedExpr cenv env (overallPatTy, rhsExprChecked, overallExprTy, mBinding) + else rhsExprChecked // Assert the return type of an active pattern match apinfoOpt with @@ -9906,7 +10064,7 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt () // Check other attributes - let hasLiteralAttr,konst = TcLiteral cenv overallTy env tpenv (valAttribs,rhsExpr) + let hasLiteralAttr,konst = TcLiteral cenv overallExprTy env tpenv (valAttribs,rhsExpr) if hasLiteralAttr && isThreadStatic then errorR(Error(FSComp.SR.tcIllegalAttributesForLiteral(),mBinding)) if hasLiteralAttr && isMutable then @@ -9916,7 +10074,7 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt if hasLiteralAttr && nonNil declaredTypars then errorR(Error(FSComp.SR.tcLiteralCannotHaveGenericParameters(),mBinding)) - CheckedBindingInfo(inlineFlag,true,valAttribs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExpr',argAndRetAttribs,overallTy,mBinding,spBind,compgen,konst),tpenv + CheckedBindingInfo(inlineFlag,valAttribs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExprChecked,argAndRetAttribs,overallPatTy,mBinding,spBind,compgen,konst,isFixed),tpenv and TcLiteral cenv overallTy env tpenv (attrs,synLiteralValExpr) = let hasLiteralAttr = HasFSharpAttribute cenv.g cenv.g.attrib_LiteralAttribute attrs @@ -9958,10 +10116,10 @@ and TcNonrecBindingTyparDecls cenv env tpenv bind = let (NormalizedBinding(_,_,_,_,_,_,synTyparDecls,_,_,_,_,_)) = bind TcBindingTyparDecls true cenv env tpenv synTyparDecls -and TcNonRecursiveBinding declKind cenv env tpenv ty b = +and TcNonRecursiveBinding declKind cenv env tpenv isUse ty b = let b = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env b let flex, tpenv = TcNonrecBindingTyparDecls cenv env tpenv b - TcNormalizedBinding declKind cenv env tpenv ty None NoSafeInitInfo ([],flex) b + TcNormalizedBinding declKind cenv env tpenv isUse ty None NoSafeInitInfo ([],flex) b //------------------------------------------------------------------------- // TcAttribute* @@ -10164,14 +10322,14 @@ and TcAttributes cenv env attrTgt synAttribs = and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scopem) = // Typecheck all the bindings... - let binds',tpenv = List.mapFold (fun tpenv b -> TcNonRecursiveBinding declKind cenv env tpenv (NewInferenceType ()) b) tpenv binds + let binds',tpenv = List.mapFold (fun tpenv b -> TcNonRecursiveBinding declKind cenv env tpenv isUse (NewInferenceType ()) b) tpenv binds let (ContainerInfo(altActualParent,_)) = containerInfo // Canonicalize constraints prior to generalization let denv = env.DisplayEnv GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv,denv,bindsm) (binds' |> List.collect (fun tbinfo -> - let (CheckedBindingInfo(_,_,_,_,_,flex,_,_,_,tauTy,_,_,_,_)) = tbinfo + let (CheckedBindingInfo(_,_,_,_,flex,_,_,_,tauTy,_,_,_,_,_)) = tbinfo let (ExplicitTyparInfo(_,declaredTypars,_)) = flex let maxInferredTypars = (freeInTypeLeftToRight cenv.g false tauTy) declaredTypars @ maxInferredTypars)) @@ -10180,7 +10338,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope // Generalize the bindings... (((fun x -> x), env, tpenv), binds') ||> List.fold (fun (mkf_sofar,env,tpenv) tbinfo -> - let (CheckedBindingInfo(inlineFlag,immut,attrs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExpr,_,tauTy,m,spBind,_,konst)) = tbinfo + let (CheckedBindingInfo(inlineFlag,attrs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExpr,_,tauTy,m,spBind,_,konst,isFixed)) = tbinfo let enclosingDeclaredTypars = [] let (ExplicitTyparInfo(_,declaredTypars,canInferTypars)) = flex let allDeclaredTypars = enclosingDeclaredTypars @ declaredTypars @@ -10194,7 +10352,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope [] else let freeInEnv = lazyFreeInEnv.Force() - GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv, m, immut, freeInEnv, canInferTypars, GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl(declKind), inlineFlag, Some rhsExpr, allDeclaredTypars, maxInferredTypars,tauTy,false) + GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv, m, true, freeInEnv, canInferTypars, GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl(declKind), inlineFlag, Some rhsExpr, allDeclaredTypars, maxInferredTypars,tauTy,false) let prelimValSchemes2 = GeneralizeVals cenv denv enclosingDeclaredTypars generalizedTypars nameToPrelimValSchemeMap @@ -10209,13 +10367,13 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope let prelimRecValues = NameMap.map fst values // Now bind the r.h.s. to the l.h.s. - let rhse = mkTypeLambda m generalizedTypars (rhsExpr,tauTy) + let rhsExpr = mkTypeLambda m generalizedTypars (rhsExpr,tauTy) match pat' with // Don't introduce temporary or 'let' for 'match against wild' or 'match against unit' - | (TPat_wild _ | TPat_const (Const.Unit,_)) when not isUse && isNil generalizedTypars -> - let mk_seq_bind (tm,tmty) = (mkSequential SequencePointsAtSeq m rhse tm, tmty) + | (TPat_wild _ | TPat_const (Const.Unit,_)) when not isUse && not isFixed && isNil generalizedTypars -> + let mk_seq_bind (tm,tmty) = (mkSequential SequencePointsAtSeq m rhsExpr tm, tmty) (mk_seq_bind << mkf_sofar,env,tpenv) | _ -> @@ -10226,38 +10384,42 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope // nice: don't introduce awful temporary for r.h.s. in the 99% case where we know what we're binding it to | TPat_as (pat1,PBind(v,TypeScheme(generalizedTypars',_)),_) when List.lengthsEqAndForall2 typarRefEq generalizedTypars generalizedTypars' -> + v, pat1 | _ when mustinline(inlineFlag) -> error(Error(FSComp.SR.tcInvalidInlineSpecification(),m)) | _ -> let tmp,_ = mkCompGenLocal m "patternInput" (generalizedTypars +-> tauTy) - if isUse then + if isUse || isFixed then errorR(Error(FSComp.SR.tcInvalidUseBinding(),m)) // This assignment forces representation as module value, to maintain the invariant from the // type checker that anything related to binding module-level values is marked with an // val_repr_info, val_actual_parent and is_topbind if (DeclKind.MustHaveArity declKind) then - AdjustValToTopVal tmp altActualParent (InferArityOfExprBinding cenv.g tmp rhse) + AdjustValToTopVal tmp altActualParent (InferArityOfExprBinding cenv.g tmp rhsExpr) tmp,pat' - let mkRhsBind (tm,tmty) = (mkLet spBind m tmp rhse tm),tmty + let mkRhsBind (bodyExpr,bodyExprTy) = + let letExpr = mkLet spBind m tmp rhsExpr bodyExpr + letExpr,bodyExprTy + let allValsDefinedByPattern = (NameMap.range prelimRecValues |> FlatList.ofList) - let mkPatBind (tm,tmty) = + let mkPatBind (bodyExpr,bodyExprTy) = let valsDefinedByMatching = FlatListSet.remove valEq tmp allValsDefinedByPattern - let matchx = CompilePatternForMatch cenv env m m true ThrowIncompleteMatchException (tmp,generalizedTypars) [TClause(pat'',None,TTarget(valsDefinedByMatching,tm,SuppressSequencePointAtTarget),m)] tauTy tmty + let matchx = CompilePatternForMatch cenv env m m true ThrowIncompleteMatchException (tmp,generalizedTypars) [TClause(pat'',None,TTarget(valsDefinedByMatching,bodyExpr,SuppressSequencePointAtTarget),m)] tauTy bodyExprTy let matchx = if (DeclKind.ConvertToLinearBindings declKind) then LinearizeTopMatch cenv.g altActualParent matchx else matchx - matchx,tmty + matchx,bodyExprTy - let mkCleanup (tm,tmty) = - if isUse then - (allValsDefinedByPattern,(tm,tmty)) ||> FlatList.foldBack (fun v (tm,tmty) -> + let mkCleanup (bodyExpr,bodyExprTy) = + if isUse && not isFixed then + (allValsDefinedByPattern,(bodyExpr,bodyExprTy)) ||> FlatList.foldBack (fun v (bodyExpr,bodyExprTy) -> AddCxTypeMustSubsumeType ContextInfo.NoContext denv cenv.css v.Range NoTrace cenv.g.system_IDisposable_typ v.Type let cleanupE = BuildDisposableCleanup cenv env m v - mkTryFinally cenv.g (tm,cleanupE,m,tmty,SequencePointInBodyOfTry,NoSequencePointAtFinally),tmty) + mkTryFinally cenv.g (bodyExpr,cleanupE,m,bodyExprTy,SequencePointInBodyOfTry,NoSequencePointAtFinally),bodyExprTy) else - (tm,tmty) + (bodyExpr,bodyExprTy) ((mkRhsBind << mkPatBind << mkCleanup << mkf_sofar), AddLocalValMap cenv.tcSink scopem prelimRecValues env, @@ -10809,7 +10971,7 @@ and TcLetrecBinding let envRec = MakeInnerEnvForMember cenv envRec vspec let checkedBind,tpenv = - TcNormalizedBinding declKind cenv envRec tpenv tau safeThisValOpt safeInitInfo (enclosingDeclaredTypars,flex) rbind.SyntacticBinding + TcNormalizedBinding declKind cenv envRec tpenv false tau safeThisValOpt safeInitInfo (enclosingDeclaredTypars,flex) rbind.SyntacticBinding (try UnifyTypes cenv envRec vspec.Range (allDeclaredTypars +-> tau) vspec.Type with e -> error (Recursion(envRec.DisplayEnv,vspec.Id,tau,vspec.Type,vspec.Range))) @@ -11026,7 +11188,7 @@ and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgr let rbinfo = pgrbind.RecBindingInfo let vspec = rbinfo.Val - let (CheckedBindingInfo(inlineFlag,immut,_,_,_,_,_,expr,_,_,m,_,_,_)) = pgrbind.CheckedBinding + let (CheckedBindingInfo(inlineFlag,_,_,_,_,_,expr,_,_,m,_,_,_,_)) = pgrbind.CheckedBinding let (ExplicitTyparInfo(rigidCopyOfDeclaredTypars,declaredTypars,_)) = rbinfo.ExplicitTyparInfo let allDeclaredTypars = rbinfo.EnclosingDeclaredTypars @ declaredTypars @@ -11047,7 +11209,7 @@ and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgr let maxInferredTypars = freeInTypeLeftToRight cenv.g false tau let canGeneralizeConstrained = GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl rbinfo.DeclKind - let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv,denv,m,immut,freeInEnv,canInferTypars,canGeneralizeConstrained,inlineFlag, Some(expr), allDeclaredTypars, maxInferredTypars,tau,isCtor) + let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv,denv,m,true,freeInEnv,canInferTypars,canGeneralizeConstrained,inlineFlag, Some(expr), allDeclaredTypars, maxInferredTypars,tau,isCtor) generalizedTypars /// Compute the type variables which may have member constraints that need to be canonicalized prior to generalization @@ -11065,8 +11227,11 @@ and TcLetrecComputeSupportForBinding cenv (pgrbind : PreGeneralizationRecursiveB and TcLetrecGeneralizeBinding cenv denv generalizedTypars (pgrbind : PreGeneralizationRecursiveBinding) : PostGeneralizationRecursiveBinding = let (RBInfo(_,_,enclosingDeclaredTypars,_,vspec,flex,partialValReprInfo,memberInfoOpt,_,_,_,vis,_,declKind)) = pgrbind.RecBindingInfo - let (CheckedBindingInfo(inlineFlag,_,_,_,_,_,_,expr,argAttribs,_,_,_,compgen,_)) = pgrbind.CheckedBinding + let (CheckedBindingInfo(inlineFlag,_,_,_,_,_,expr,argAttribs,_,_,_,compgen,_,isFixed)) = pgrbind.CheckedBinding + if isFixed then + errorR(Error(FSComp.SR.tcFixedNotAllowed(),expr.Range)) + let _,tau = vspec.TypeScheme let pvalscheme1 = PrelimValScheme1(vspec.Id,flex,tau,Some(partialValReprInfo),memberInfoOpt,false,inlineFlag,NormalVal,argAttribs,vis,compgen) @@ -11095,7 +11260,7 @@ and MakeCheckSafeInitField g tinst thisValOpt rfref reqExpr (expr:Expr) = | None -> mkStaticRecdFieldGet (rfref, tinst, m) | Some thisVar -> // This is an instance method, it must have a 'this' var - mkRecdFieldGet g (exprForVal m thisVar, rfref, tinst, m) + mkRecdFieldGetViaExprAddr (exprForVal m thisVar, rfref, tinst, m) let failureExpr = match thisValOpt with None -> mkCallFailStaticInit g m | Some _ -> mkCallFailInit g m mkCompGenSequential m (mkIfThen g m (mkILAsmClt g m availExpr reqExpr) failureExpr) expr @@ -11696,7 +11861,7 @@ module IncrClassChecking = // --- Create this for use inside constructor let thisId = ident ("this",m) let thisValScheme = ValScheme(thisId,NonGenericTypeScheme(thisTy),None,None,false,ValInline.Never,CtorThisVal,None,true,false,false,false) - let thisVal = MakeAndPublishVal cenv env (ParentNone,false,ClassLetBinding,ValNotInRecScope,thisValScheme,[],XmlDoc.Empty,None,false) + let thisVal = MakeAndPublishVal cenv env (ParentNone,false,ClassLetBinding(false),ValNotInRecScope,thisValScheme,[],XmlDoc.Empty,None,false) thisVal {TyconRef = tcref @@ -12239,7 +12404,7 @@ module IncrClassChecking = let binders = [ match ctorInfo.InstanceCtorSafeInitInfo with | SafeInitField (rfref, _) -> - let setExpr = mkRecdFieldSet cenv.g (exprForVal m thisVal, rfref, thisTyInst, mkOne cenv.g m, m) + let setExpr = mkRecdFieldSetViaExprAddr (exprForVal m thisVal, rfref, thisTyInst, mkOne cenv.g m, m) let setExpr = reps.FixupIncrClassExprPhase2C (Some(thisVal)) safeStaticInitInfo thisTyInst setExpr let binder = (fun e -> mkSequential SequencePointsAtSeq setExpr.Range setExpr e) let isPriorToSuperInit = false @@ -12490,81 +12655,79 @@ module MutRecBindingChecking = if tcref.IsEnumTycon && (declKind <> ExtrinsicExtensionBinding) then error(Error(FSComp.SR.tcEnumerationsMayNotHaveMembers(),(trimRangeToLine m))) // ideally we'd have the 'm' of the type declaration stored here, to avoid needing to trim to line to approx match classMemberDef, containerInfo with - - | SynMemberDefn.ImplicitCtor (vis,attrs,spats,thisIdOpt, m), ContainerInfo(_,Some(MemberOrValContainerInfo(tcref, _, baseValOpt, safeInitInfo, _))) -> - match tcref.TypeOrMeasureKind with TyparKind.Measure -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) | _ -> () + | SynMemberDefn.ImplicitCtor (vis,attrs,spats,thisIdOpt, m), ContainerInfo(_,Some(MemberOrValContainerInfo(tcref, _, baseValOpt, safeInitInfo, _))) -> + if tcref.TypeOrMeasureKind = TyparKind.Measure then + error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) - // Phase2A: make incrClassCtorLhs - ctorv, thisVal etc, type depends on argty(s) - let incrClassCtorLhs = TcImplictCtorLhs_Phase2A(cenv,envForTycon,tpenv,tcref,vis,attrs,spats,thisIdOpt,baseValOpt,safeInitInfo,m,copyOfTyconTypars,objTy,thisTy) - // Phase2A: Add copyOfTyconTypars from incrClassCtorLhs - or from tcref - let envForTycon = AddDeclaredTypars CheckForDuplicateTypars incrClassCtorLhs.InstanceCtorDeclaredTypars envForTycon - let innerState = (Some incrClassCtorLhs, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) + // Phase2A: make incrClassCtorLhs - ctorv, thisVal etc, type depends on argty(s) + let incrClassCtorLhs = TcImplictCtorLhs_Phase2A(cenv,envForTycon,tpenv,tcref,vis,attrs,spats,thisIdOpt,baseValOpt,safeInitInfo,m,copyOfTyconTypars,objTy,thisTy) + // Phase2A: Add copyOfTyconTypars from incrClassCtorLhs - or from tcref + let envForTycon = AddDeclaredTypars CheckForDuplicateTypars incrClassCtorLhs.InstanceCtorDeclaredTypars envForTycon + let innerState = (Some incrClassCtorLhs, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) - [Phase2AIncrClassCtor incrClassCtorLhs],innerState - - | SynMemberDefn.ImplicitInherit (typ,arg,_baseIdOpt,m),_ -> - match tcref.TypeOrMeasureKind with TyparKind.Measure -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) | _ -> () - // Phase2A: inherit typ(arg) as base - pass through - // Phase2A: pick up baseValOpt! - let baseValOpt = incrClassCtorLhsOpt |> Option.bind (fun x -> x.InstanceCtorBaseValOpt) - let innerState = (incrClassCtorLhsOpt,envForTycon,tpenv,recBindIdx,uncheckedBindsRev) - [Phase2AInherit (typ,arg,baseValOpt,m); Phase2AIncrClassCtorJustAfterSuperInit], innerState - + [Phase2AIncrClassCtor incrClassCtorLhs],innerState + | SynMemberDefn.ImplicitInherit (typ,arg,_baseIdOpt,m),_ -> + if tcref.TypeOrMeasureKind = TyparKind.Measure then + error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) + + // Phase2A: inherit typ(arg) as base - pass through + // Phase2A: pick up baseValOpt! + let baseValOpt = incrClassCtorLhsOpt |> Option.bind (fun x -> x.InstanceCtorBaseValOpt) + let innerState = (incrClassCtorLhsOpt,envForTycon,tpenv,recBindIdx,uncheckedBindsRev) + [Phase2AInherit (typ,arg,baseValOpt,m); Phase2AIncrClassCtorJustAfterSuperInit], innerState + + | SynMemberDefn.LetBindings (letBinds,isStatic,isRec,m),_ -> + match tcref.TypeOrMeasureKind,isStatic with + | TyparKind.Measure,false -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) + | _ -> () - | SynMemberDefn.LetBindings (letBinds,isStatic,isRec,m),_ -> - match tcref.TypeOrMeasureKind,isStatic with - | TyparKind.Measure,false -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) - | _,_ -> () - - if tcref.IsStructOrEnumTycon && not isStatic then - let allDo = letBinds |> List.forall (function (Binding(_,DoBinding,_,_,_,_,_,_,_,_,_,_)) -> true | _ -> false) - // Code for potential future design change to allow functions-compiled-as-members in structs - //let allFun = letBinds |> List.forall (function (Binding(_,NormalBinding,_,_,_,_,SynValData(_,info,_),_,_,_,_,_)) -> not (SynInfo.HasNoArgs info) | _ -> false) - if allDo then - errorR(Deprecated(FSComp.SR.tcStructsMayNotContainDoBindings(),(trimRangeToLine m))) - else - // Code for potential future design change to allow functions-compiled-as-members in structs - //elif not allFun then - errorR(Error(FSComp.SR.tcStructsMayNotContainLetBindings(),(trimRangeToLine m))) - - if isStatic && isNone incrClassCtorLhsOpt then - errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(),m)) + if tcref.IsStructOrEnumTycon && not isStatic then + let allDo = letBinds |> List.forall (function (Binding(_,DoBinding,_,_,_,_,_,_,_,_,_,_)) -> true | _ -> false) + // Code for potential future design change to allow functions-compiled-as-members in structs + if allDo then + errorR(Deprecated(FSComp.SR.tcStructsMayNotContainDoBindings(),(trimRangeToLine m))) + else + // Code for potential future design change to allow functions-compiled-as-members in structs + errorR(Error(FSComp.SR.tcStructsMayNotContainLetBindings(),(trimRangeToLine m))) + + if isStatic && isNone incrClassCtorLhsOpt then + errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(),m)) - // Phase2A: let-bindings - pass through - let innerState = (incrClassCtorLhsOpt,envForTycon,tpenv,recBindIdx,uncheckedBindsRev) - [Phase2AIncrClassBindings (tcref,letBinds,isStatic,isRec,m)], innerState + // Phase2A: let-bindings - pass through + let innerState = (incrClassCtorLhsOpt,envForTycon,tpenv,recBindIdx,uncheckedBindsRev) + [Phase2AIncrClassBindings (tcref,letBinds,isStatic,isRec,m)], innerState - | SynMemberDefn.Member (bind,m),_ -> - // Phase2A: member binding - create prelim valspec (for recursive reference) and RecursiveBindingInfo - let (NormalizedBinding(_,_,_,_,_,_,_,valSynData,_,_,_,_)) as bind = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv envForTycon bind - let (SynValData(memberFlagsOpt,_,_)) = valSynData - match tcref.TypeOrMeasureKind with - | TyparKind.Type -> () - | TyparKind.Measure -> - match memberFlagsOpt with - | None -> () - | Some memberFlags -> - if memberFlags.IsInstance then error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) - match memberFlags.MemberKind with - | MemberKind.Constructor -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembersNotConstructors(), m)) - | _ -> () - let rbind = NormalizedRecBindingDefn(containerInfo,newslotsOK,declKind,bind) - let overridesOK = DeclKind.CanOverrideOrImplement(declKind) - let (binds,_values),(tpenv,recBindIdx) = AnalyzeAndMakeAndPublishRecursiveValue overridesOK false cenv envForTycon (tpenv,recBindIdx) rbind - let cbinds = [ for rbind in binds -> Phase2AMember rbind ] - - let innerState = (incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, List.rev binds @ uncheckedBindsRev) - cbinds,innerState + | SynMemberDefn.Member (bind,m),_ -> + // Phase2A: member binding - create prelim valspec (for recursive reference) and RecursiveBindingInfo + let (NormalizedBinding(_,_,_,_,_,_,_,valSynData,_,_,_,_)) as bind = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv envForTycon bind + let (SynValData(memberFlagsOpt,_,_)) = valSynData + match tcref.TypeOrMeasureKind with + | TyparKind.Type -> () + | TyparKind.Measure -> + match memberFlagsOpt with + | None -> () + | Some memberFlags -> + if memberFlags.IsInstance then error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) + match memberFlags.MemberKind with + | MemberKind.Constructor -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembersNotConstructors(), m)) + | _ -> () + let rbind = NormalizedRecBindingDefn(containerInfo,newslotsOK,declKind,bind) + let overridesOK = DeclKind.CanOverrideOrImplement(declKind) + let (binds,_values),(tpenv,recBindIdx) = AnalyzeAndMakeAndPublishRecursiveValue overridesOK false cenv envForTycon (tpenv,recBindIdx) rbind + let cbinds = [ for rbind in binds -> Phase2AMember rbind ] + + let innerState = (incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, List.rev binds @ uncheckedBindsRev) + cbinds,innerState #if OPEN_IN_TYPE_DECLARATIONS - | SynMemberDefn.Open (mp,m),_ -> - let innerState = (incrClassCtorLhsOpt,env,tpenv,recBindIdx,prelimRecValuesRev,uncheckedBindsRev) - [ Phase2AOpen (mp,m) ], innerState + | SynMemberDefn.Open (mp,m),_ -> + let innerState = (incrClassCtorLhsOpt,env,tpenv,recBindIdx,prelimRecValuesRev,uncheckedBindsRev) + [ Phase2AOpen (mp,m) ], innerState #endif - | _ -> - error(InternalError("Unexpected definition",m))) + | _ -> + error(InternalError("Unexpected definition",m))) // If no constructor call, insert Phase2AIncrClassCtorJustAfterSuperInit at start let defnAs = @@ -12716,14 +12879,14 @@ module MutRecBindingChecking = if isRec then // Type check local recursive binding - let binds = binds |> List.map (fun bind -> RecDefnBindingInfo(ExprContainerInfo,NoNewSlots,ClassLetBinding,bind)) + let binds = binds |> List.map (fun bind -> RecDefnBindingInfo(ExprContainerInfo,NoNewSlots,ClassLetBinding(isStatic),bind)) let binds,env,tpenv = TcLetrec ErrorOnOverrides cenv envForBinding tpenv (binds,scopem(*bindsm*),scopem) let bindRs = [IncrClassBindingGroup(binds,isStatic,true)] binds,bindRs,env,tpenv else // Type check local binding - let binds,env,tpenv = TcLetBindings cenv envForBinding ExprContainerInfo ClassLetBinding tpenv (binds,bindsm,scopem) + let binds,env,tpenv = TcLetBindings cenv envForBinding ExprContainerInfo (ClassLetBinding(isStatic)) tpenv (binds,bindsm,scopem) let binds,bindRs = binds |> List.map (function @@ -13880,7 +14043,7 @@ module EstablishTypeDefinitionCores = if hasClassAttr && not (match k with TyconClass -> true | _ -> false) || hasMeasureAttr && not (match k with TyconClass | TyconAbbrev | TyconHiddenRepr -> true | _ -> false) || hasInterfaceAttr && not (match k with TyconInterface -> true | _ -> false) || - hasStructAttr && not (match k with TyconStruct | TyconRecord -> true | _ -> false) then + hasStructAttr && not (match k with TyconStruct | TyconRecord | TyconUnion -> true | _ -> false) then error(Error(FSComp.SR.tcKindOfTypeSpecifiedDoesNotMatchDefinition(),m)) k @@ -13907,13 +14070,14 @@ module EstablishTypeDefinitionCores = [ match synTyconRepr with | SynTypeDefnSimpleRepr.None _ -> () | SynTypeDefnSimpleRepr.Union (_,unionCases,_) -> + for (UnionCase (_,_,args,_,_,m)) in unionCases do - match args with - | UnionCaseFields flds -> + match args with + | UnionCaseFields flds -> for (Field(_,_,_,ty,_,_,_,m)) in flds do let ty',_ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty yield (ty',m) - | UnionCaseFullType (ty,arity) -> + | UnionCaseFullType (ty,arity) -> let ty',_ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty let argtysl,_ = GetTopTauTypeInFSharpForm cenv.g (arity |> TranslateTopValSynInfo m (TcAttributes cenv env) |> TranslatePartialArity []).ArgInfos ty' m if argtysl.Length > 1 then @@ -13947,19 +14111,28 @@ module EstablishTypeDefinitionCores = | _ -> () ] - let ComputeModuleOrNamespaceKind g isModule attribs = + let ComputeModuleOrNamespaceKind g isModule typeNames attribs nm = if not isModule then Namespace - elif ModuleNameIsMangled g attribs then FSharpModuleWithSuffix + elif ModuleNameIsMangled g attribs || Set.contains nm typeNames then FSharpModuleWithSuffix else ModuleOrType let AdjustModuleName modKind nm = (match modKind with FSharpModuleWithSuffix -> nm+FSharpModuleSuffix | _ -> nm) - let TcTyconDefnCore_Phase1A_BuildInitialModule cenv envInitial parent compInfo = + let TypeNamesInMutRecDecls (compDecls: MutRecShapes) = + [ for d in compDecls do + match d with + | MutRecShape.Tycon (MutRecDefnsPhase1DataForTycon(ComponentInfo(_,_,_,ids,_,_,_,_),_,_,_,_,isAtOriginalTyconDefn),_) -> + if isAtOriginalTyconDefn then + yield (List.last ids).idText + | _ -> () ] + |> set + + let TcTyconDefnCore_Phase1A_BuildInitialModule cenv envInitial parent typeNames compInfo compDecls = let (ComponentInfo(attribs,_parms, _constraints,longPath,xml,_,vis,im)) = compInfo let id = ComputeModuleName longPath let modAttrs = TcAttributes cenv envInitial AttributeTargets.ModuleDecl attribs - let modKind = ComputeModuleOrNamespaceKind cenv.g true modAttrs + let modKind = ComputeModuleOrNamespaceKind cenv.g true typeNames modAttrs id.idText let modName = AdjustModuleName modKind id.idText let vis,_ = ComputeAccessAndCompPath envInitial None id.idRange vis parent @@ -13972,14 +14145,15 @@ module EstablishTypeDefinitionCores = let envForDecls, mtypeAcc = MakeInnerEnv envInitial id modKind let mspec = NewModuleOrNamespace (Some envInitial.eCompPath) vis id (xml.ToXmlDoc()) modAttrs (notlazy (NewEmptyModuleOrNamespaceType modKind)) let innerParent = Parent (mkLocalModRef mspec) - MutRecDefnsPhase2DataForModule (mtypeAcc, mspec), (innerParent, envForDecls) + let typeNames = TypeNamesInMutRecDecls compDecls + MutRecDefnsPhase2DataForModule (mtypeAcc, mspec), (innerParent, typeNames, envForDecls) /// Establish 'type C < T1... TN > = ...' including /// - computing the mangled name for C /// but /// - we don't yet 'properly' establish constraints on type parameters let private TcTyconDefnCore_Phase1A_BuildInitialTycon cenv env parent (MutRecDefnsPhase1DataForTycon(synTyconInfo,synTyconRepr,_,preEstablishedHasDefaultCtor,hasSelfReferentialCtor, _)) = - let (ComponentInfo(_, synTypars, _, id, doc, preferPostfix, synVis, _)) = synTyconInfo + let (ComponentInfo (_, synTypars, _,id, doc, preferPostfix, synVis,_)) = synTyconInfo let checkedTypars = TcTyparDecls cenv env synTypars id |> List.iter (CheckNamespaceModuleOrTypeName cenv.g) match synTyconRepr with @@ -13990,7 +14164,6 @@ module EstablishTypeDefinitionCores = // Augmentations of type definitions are allowed within the same file as long as no new type representation or abbreviation is given CheckForDuplicateConcreteType env id.idText id.idRange - CheckForDuplicateModule env id.idText id.idRange let vis,cpath = ComputeAccessAndCompPath env None id.idRange synVis parent // Establish the visibility of the representation, e.g. @@ -14036,12 +14209,15 @@ module EstablishTypeDefinitionCores = let attrs, getFinalAttrs = TcAttributesCanFail cenv envinner AttributeTargets.TyconDecl synAttrs let hasMeasureAttr = HasFSharpAttribute cenv.g cenv.g.attrib_MeasureAttribute attrs - let isStructRecordType = + let isStructRecordOrUnionType = match synTyconRepr with - | SynTypeDefnSimpleRepr.Record _ -> HasFSharpAttribute cenv.g cenv.g.attrib_StructAttribute attrs - | _ -> false + | SynTypeDefnSimpleRepr.Record _ + | SynTypeDefnSimpleRepr.Union _ -> + HasFSharpAttribute cenv.g cenv.g.attrib_StructAttribute attrs + | _ -> + false - tycon.SetIsStructRecordType isStructRecordType + tycon.SetIsStructRecordOrUnion isStructRecordOrUnionType // Set the compiled name, if any tycon.Data.entity_compiled_name <- TryFindFSharpStringAttribute cenv.g cenv.g.attrib_CompiledNameAttribute attrs @@ -14438,10 +14614,10 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Exception _ -> Some cenv.g.exn_ty | SynTypeDefnSimpleRepr.None _ -> None | SynTypeDefnSimpleRepr.TypeAbbrev _ -> None - | SynTypeDefnSimpleRepr.Union _ -> None | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly _ -> None + | SynTypeDefnSimpleRepr.Union _ | SynTypeDefnSimpleRepr.Record _ -> - if tycon.IsStructRecordTycon then Some(cenv.g.system_Value_typ) + if tycon.IsStructRecordOrUnionTycon then Some(cenv.g.system_Value_typ) else None | SynTypeDefnSimpleRepr.General (kind,_,slotsigs,fields,isConcrete,_,_,_) -> let kind = InferTyconKind cenv.g (kind,attrs,slotsigs,fields,inSig,isConcrete,m) @@ -14639,6 +14815,10 @@ module EstablishTypeDefinitionCores = noAllowNullLiteralAttributeCheck() structLayoutAttributeCheck(false) let unionCases = TcRecdUnionAndEnumDeclarations.TcUnionCaseDecls cenv envinner innerParent thisTy tpenv unionCases + + if tycon.IsStructRecordOrUnionTycon && unionCases.Length > 1 then + errorR(Error(FSComp.SR.tcStructUnionMultiCase(),m)) + writeFakeUnionCtorsToSink unionCases MakeUnionRepr unionCases, None, NoSafeInitInfo @@ -14976,11 +15156,18 @@ module EstablishTypeDefinitionCores = else // Only collect once from each type instance. let doneTypes = ty :: doneTypes - let fspecs = structTycon.AllFieldsAsList |> List.filter (fun fspec -> includeStaticFields || not fspec.IsStatic) + let fspecs = + if structTycon.IsUnionTycon then + [ for uc in structTycon.UnionCasesArray do + for c in uc.FieldTable.AllFieldsAsList do + yield c] + else + structTycon.AllFieldsAsList + let fspecs = fspecs |> List.filter (fun fspec -> includeStaticFields || not fspec.IsStatic) let doneTypes,acc = List.foldBack (accStructField structTycon tinst) fspecs (doneTypes,acc) doneTypes,acc and accStructInstanceFields ty structTycon tinst (doneTypes,acc) = accStructFields false ty structTycon tinst (doneTypes,acc) - and accStructAllFields ty structTycon tinst (doneTypes,acc) = accStructFields true ty structTycon tinst (doneTypes,acc) + and accStructAllFields ty (structTycon: Tycon) tinst (doneTypes,acc) = accStructFields true ty structTycon tinst (doneTypes,acc) let acc = [] let acc = @@ -15024,20 +15211,20 @@ module EstablishTypeDefinitionCores = | _ -> ()) - let TcMutRecDefns_Phase1 mkLetInfo cenv envInitial parent inSig tpenv m scopem mutRecNSInfo (typeDefCores:MutRecShapes) = + let TcMutRecDefns_Phase1 mkLetInfo cenv envInitial parent inSig tpenv m scopem mutRecNSInfo (mutRecDefns:MutRecShapes) = // Phase1A - build Entity for type definitions, exception definitions and module definitions. // Also for abbreviations of any of these. Augmentations are skipped in this phase. let withEntities = - typeDefCores + mutRecDefns |> MutRecShapes.mapWithParent - (parent, envInitial) + (parent, TypeNamesInMutRecDecls mutRecDefns, envInitial) // Build the initial entity for each module definition - (fun (innerParent, envForDecls) compInfo -> - TcTyconDefnCore_Phase1A_BuildInitialModule cenv envForDecls innerParent compInfo) + (fun (innerParent, typeNames, envForDecls) compInfo decls -> + TcTyconDefnCore_Phase1A_BuildInitialModule cenv envForDecls innerParent typeNames compInfo decls) // Build the initial Tycon for each type definition - (fun (innerParent, envForDecls) (typeDefCore,tyconMemberInfo) -> + (fun (innerParent, _, envForDecls) (typeDefCore,tyconMemberInfo) -> let (MutRecDefnsPhase1DataForTycon(_,_,_,_,_,isAtOriginalTyconDefn)) = typeDefCore let tyconOpt = if isAtOriginalTyconDefn then @@ -15047,7 +15234,7 @@ module EstablishTypeDefinitionCores = (typeDefCore, tyconMemberInfo, innerParent), tyconOpt) // Bundle up the data for each 'val', 'member' or 'let' definition (just package up the data, no processing yet) - (fun (innerParent,_) synBinds -> + (fun (innerParent, _, _) synBinds -> let containerInfo = ModuleOrNamespaceContainerInfo(match innerParent with Parent p -> p | _ -> failwith "unreachable") mkLetInfo containerInfo synBinds) @@ -15068,7 +15255,6 @@ module EstablishTypeDefinitionCores = tyconOpt |> Option.iter (fun tycon -> // recheck these in case type is a duplicate in a mutually recursive set CheckForDuplicateConcreteType envAbove tycon.LogicalName tycon.Range - CheckForDuplicateModule envAbove tycon.LogicalName tycon.Range PublishTypeDefn cenv envAbove tycon)) // Updates the types of the modules to contain the contents so far @@ -15479,7 +15665,7 @@ module TcDeclarations = | SynTypeDefnRepr.Simple(repr,_) -> let members = [] - let isAtOriginalTyconDefn = not (isAugmentationTyconDefnRepr repr) + let isAtOriginalTyconDefn = true let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, repr, implements1, false, false, isAtOriginalTyconDefn) core, members @ extraMembers @@ -15560,8 +15746,10 @@ module TcDeclarations = /// Separates the signature declaration into core (shape) and body. let rec private SplitTyconSignature (TypeDefnSig(synTyconInfo,trepr,extraMembers,_)) = + let implements1 = extraMembers |> List.choose (function SynMemberSig.Interface (f,m) -> Some(f,m) | _ -> None) + match trepr with | SynTypeDefnSigRepr.ObjectModel(kind,cspec,m) -> let fields = cspec |> List.choose (function SynMemberSig.ValField (f,_) -> Some(f) | _ -> None) @@ -15669,7 +15857,7 @@ module TcDeclarations = // Bind module types //------------------------------------------------------------------------- -let rec TcSignatureElementNonMutRec cenv parent endm (env: TcEnv) synSigDecl : Eventually = +let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synSigDecl : Eventually = eventually { try match synSigDecl with @@ -15710,10 +15898,9 @@ let rec TcSignatureElementNonMutRec cenv parent endm (env: TcEnv) synSigDecl : E let vis,_ = ComputeAccessAndCompPath env None im vis parent let attribs = TcAttributes cenv env AttributeTargets.ModuleDecl attribs CheckNamespaceModuleOrTypeName cenv.g id - let modKind = EstablishTypeDefinitionCores.ComputeModuleOrNamespaceKind cenv.g true attribs + let modKind = EstablishTypeDefinitionCores.ComputeModuleOrNamespaceKind cenv.g true typeNames attribs id.idText let modName = EstablishTypeDefinitionCores.AdjustModuleName modKind id.idText CheckForDuplicateConcreteType env modName id.idRange - CheckForDuplicateModule env id.idText id.idRange // Now typecheck the signature, accumulating and then recording the submodule description. let id = ident (modName, id.idRange) @@ -15821,7 +16008,19 @@ and TcSignatureElements cenv parent endm env xml mutRecNSInfo defs = and TcSignatureElementsNonMutRec cenv parent endm env defs = eventually { - return! Eventually.fold (TcSignatureElementNonMutRec cenv parent endm ) env defs + // Collect the type names so we can implicitly add the compilation suffix to module names + let typeNames = + [ for def in defs do + match def with + | SynModuleSigDecl.Types (typeSpecs,_) -> + for (TypeDefnSig(ComponentInfo(_,_,_,ids,_,_,_,_),trepr,extraMembers,_)) in typeSpecs do + match trepr with + | SynTypeDefnSigRepr.Simple((SynTypeDefnSimpleRepr.None _),_) when nonNil extraMembers -> () + | _ -> yield (List.last ids).idText + | _ -> () ] + |> set + + return! Eventually.fold (TcSignatureElementNonMutRec cenv parent typeNames endm) env defs } and TcSignatureElementsMutRec cenv parent endm mutRecNSInfo envInitial (defs: SynModuleSigDecl list) = @@ -15938,7 +16137,7 @@ let CheckLetOrDoInNamespace binds m = error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(),binds.Head.RangeOfHeadPat)) /// The non-mutually recursive case for a declaration -let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent scopem env synDecl = +let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem env synDecl = eventually { cenv.synArgNameGenerator.Reset() let tpenv = emptyUnscopedTyparEnv @@ -16010,7 +16209,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent scopem env synDec let id = ComputeModuleName longPath let modAttrs = TcAttributes cenv env AttributeTargets.ModuleDecl attribs - let modKind = EstablishTypeDefinitionCores.ComputeModuleOrNamespaceKind cenv.g true modAttrs + let modKind = EstablishTypeDefinitionCores.ComputeModuleOrNamespaceKind cenv.g true typeNames modAttrs id.idText let modName = EstablishTypeDefinitionCores.AdjustModuleName modKind id.idText CheckForDuplicateConcreteType env modName im CheckForDuplicateModule env id.idText id.idRange @@ -16114,7 +16313,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent scopem env synDec } /// The non-mutually recursive case for a sequence of declarations -and TcModuleOrNamespaceElementsNonMutRec cenv parent endm (defsSoFar, env, envAtEnd) (moreDefs: SynModuleDecl list) = +and TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, env, envAtEnd) (moreDefs: SynModuleDecl list) = eventually { match moreDefs with | (firstDef :: otherDefs) -> @@ -16126,9 +16325,9 @@ and TcModuleOrNamespaceElementsNonMutRec cenv parent endm (defsSoFar, env, envAt // Possibly better: //let scopem = unionRanges h1.Range.EndRange endm - let! firstDef',env', envAtEnd' = TcModuleOrNamespaceElementNonMutRec cenv parent scopem env firstDef + let! firstDef',env', envAtEnd' = TcModuleOrNamespaceElementNonMutRec cenv parent typeNames scopem env firstDef // tail recursive - return! TcModuleOrNamespaceElementsNonMutRec cenv parent endm ( (firstDef' :: defsSoFar), env', envAtEnd') otherDefs + return! TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ( (firstDef' :: defsSoFar), env', envAtEnd') otherDefs | [] -> return List.rev defsSoFar, envAtEnd } @@ -16238,7 +16437,19 @@ and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo defs = return (mexpr, topAttrsNew, envAtEnd) | None -> - let! compiledDefs, envAtEnd = TcModuleOrNamespaceElementsNonMutRec cenv parent endm ([], env, env) defs + // Collect the type names so we can implicitly add the compilation suffix to module names + let typeNames = + [ for def in defs do + match def with + | SynModuleDecl.Types (typeSpecs,_) -> + for (TypeDefn(ComponentInfo(_,_,_,ids,_,_,_,_),trepr,_,_)) in typeSpecs do + match trepr with + | SynTypeDefnRepr.ObjectModel(TyconAugmentation,_,_) -> () + | _ -> yield (List.last ids).idText + | _ -> () ] + |> set + + let! compiledDefs, envAtEnd = TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ([], env, env) defs // Apply the functions for each declaration to build the overall expression-builder let mexpr = TMDefs(List.foldBack (fun (f,_) x -> f x) compiledDefs []) diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index afae87233d0..657d32c41f5 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -683,6 +683,10 @@ and /// Inserted for error recovery when there is "expr." and missing tokens or error recovery after the dot | DiscardAfterMissingQualificationAfterDot of SynExpr * range + + /// 'use x = fixed expr' + | Fixed of SynExpr * range + /// Get the syntactic range of source code covered by this construct. member e.Range = match e with @@ -742,6 +746,7 @@ and | SynExpr.YieldOrReturnFrom (_,_,m) | SynExpr.LetOrUseBang (_,_,_,_,_,_,m) | SynExpr.DoBang (_,m) -> m + | SynExpr.Fixed (_,m) -> m | SynExpr.Ident id -> id.idRange /// range ignoring any (parse error) extra trailing dots member e.RangeSansAnyExtraDot = @@ -802,6 +807,7 @@ and | 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 /// 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 = @@ -869,6 +875,7 @@ and let e = (pat.Range : range).Start mkRange m.FileName start e | SynExpr.Ident id -> id.idRange + | SynExpr.Fixed (_,m) -> m and @@ -993,7 +1000,7 @@ and SynAttributes = SynAttribute list and [] SynAttribute = - { TypeName: LongIdentWithDots; + { TypeName: LongIdentWithDots ArgExpr: SynExpr /// Target specifier, e.g. "assembly","module",etc. Target: Ident option @@ -1039,10 +1046,10 @@ and and [] MemberFlags = - { IsInstance: bool; - IsDispatchSlot: bool; - IsOverrideOrExplicitImpl: bool; - IsFinal: bool; + { IsInstance: bool + IsDispatchSlot: bool + IsOverrideOrExplicitImpl: bool + IsFinal: bool MemberKind: MemberKind } /// Note the member kind is actually computed partially by a syntax tree transformation in tc.fs @@ -2234,8 +2241,9 @@ let rec synExprContainsError inpExpr = | SynExpr.TraitCall(_,_,e,_) | SynExpr.YieldOrReturn (_,e,_) | SynExpr.YieldOrReturnFrom (_,e,_) - | SynExpr.DoBang (e,_) - | SynExpr.Paren(e,_,_,_) -> + | SynExpr.DoBang (e,_) + | SynExpr.Fixed (e,_) + | SynExpr.Paren (e,_,_,_) -> walkExpr e | SynExpr.NamedIndexedPropertySet (_,e1,e2,_) diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 344fc582482..82d0b3a35f9 100755 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -130,9 +130,8 @@ let ConsoleErrorLoggerThatQuitsAfterMaxErrors (tcConfigB:TcConfigBuilder, exiter member this.HandleIssue(tcConfigB, err, isWarning) = DoWithErrorColor isWarning (fun () -> - (writeViaBufferWithEnvironmentNewLines stderr (OutputErrorOrWarning (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,isWarning)) err; - stderr.WriteLine()) - ) + (writeViaBufferWithEnvironmentNewLines stderr (OutputErrorOrWarning (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,isWarning)) err + stderr.WriteLine())) } :> _ /// This error logger delays the messages it receives. At the end, call ForwardDelayedErrorsAndWarnings @@ -541,22 +540,22 @@ module XmlDocWriter = | Some "" -> Some mspec.LogicalName | Some p -> Some (p+"."+mspec.LogicalName) let ptext = match path with None -> "" | Some t -> t - if mspec.IsModule then doModuleMemberSig ptext mspec; + if mspec.IsModule then doModuleMemberSig ptext mspec let vals = mtype.AllValsAndMembers |> Seq.toList |> List.filter (fun x -> not x.IsCompilerGenerated) |> List.filter (fun x -> x.MemberInfo.IsNone || x.IsExtensionMember) - List.iter (doModuleSig path) mtype.ModuleAndNamespaceDefinitions; - List.iter (doTyconSig ptext) mtype.ExceptionDefinitions; - List.iter (doValSig ptext) vals; + List.iter (doModuleSig path) mtype.ModuleAndNamespaceDefinitions + List.iter (doTyconSig ptext) mtype.ExceptionDefinitions + List.iter (doValSig ptext) vals List.iter (doTyconSig ptext) mtype.TypeDefinitions - doModuleSig None generatedCcu.Contents; + doModuleSig None generatedCcu.Contents let writeXmlDoc (assemblyName,generatedCcu:CcuThunk,xmlfile) = if not (Filename.hasSuffixCaseInsensitive "xml" xmlfile ) then - error(Error(FSComp.SR.docfileNoXmlSuffix(), Range.rangeStartup)); + error(Error(FSComp.SR.docfileNoXmlSuffix(), Range.rangeStartup)) (* the xmlDocSigOf* functions encode type into string to be used in "id" *) let members = ref [] let addMember id xmlDoc = @@ -567,7 +566,7 @@ module XmlDocWriter = let doUnionCase (uc:UnionCase) = addMember uc.XmlDocSig uc.XmlDoc let doField (rf:RecdField) = addMember rf.XmlDocSig rf.XmlDoc let doTycon (tc:Tycon) = - addMember tc.XmlDocSig tc.XmlDoc; + addMember tc.XmlDocSig tc.XmlDoc for vref in tc.MembersOfFSharpTyconSorted do doVal vref.Deref for uc in tc.UnionCasesAsList do @@ -580,31 +579,31 @@ module XmlDocWriter = (* moduleSpec - recurses *) let rec doModule (mspec:ModuleOrNamespace) = let mtype = mspec.ModuleOrNamespaceType - if mspec.IsModule then modulMember mspec; + if mspec.IsModule then modulMember mspec let vals = mtype.AllValsAndMembers |> Seq.toList |> List.filter (fun x -> not x.IsCompilerGenerated) |> List.filter (fun x -> x.MemberInfo.IsNone || x.IsExtensionMember) - List.iter doModule mtype.ModuleAndNamespaceDefinitions; - List.iter doTycon mtype.ExceptionDefinitions; - List.iter doVal vals; + List.iter doModule mtype.ModuleAndNamespaceDefinitions + List.iter doTycon mtype.ExceptionDefinitions + List.iter doVal vals List.iter doTycon mtype.TypeDefinitions - doModule generatedCcu.Contents; + doModule generatedCcu.Contents use os = File.CreateText(xmlfile) - fprintfn os (""); - fprintfn os (""); - fprintfn os ("%s") assemblyName; - fprintfn os (""); + fprintfn os ("") + fprintfn os ("") + fprintfn os ("%s") assemblyName + fprintfn os ("") !members |> List.iter (fun (id,doc) -> fprintfn os "" id fprintfn os "%s" doc - fprintfn os ""); - fprintfn os ""; - fprintfn os ""; + fprintfn os "") + fprintfn os "" + fprintfn os "" //---------------------------------------------------------------------------- @@ -635,13 +634,13 @@ type ILResource with let EncodeInterfaceData(tcConfig:TcConfig,tcGlobals,exportRemapping,generatedCcu,outfile,isIncrementalBuild) = if GenerateInterfaceData(tcConfig) then - if verbose then dprintfn "Generating interface data attribute..."; + if verbose then dprintfn "Generating interface data attribute..." let resource = WriteSignatureData (tcConfig,tcGlobals,exportRemapping,generatedCcu,outfile) - if verbose then dprintf "Generated interface data attribute!\n"; + if verbose then dprintf "Generated interface data attribute!\n" // REVIEW: need a better test for this if (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib) && not isIncrementalBuild then let sigDataFileName = (Filename.chopExtension outfile)+".sigdata" - File.WriteAllBytes(sigDataFileName,resource.Bytes); + File.WriteAllBytes(sigDataFileName,resource.Bytes) let sigAttr = mkSignatureDataVersionAttr tcGlobals (IL.parseILVersion Internal.Utilities.FSharpEnvironment.FSharpBinaryMetadataFormatRevision) // The resource gets written to a file for FSharp.Core let resources = @@ -663,13 +662,13 @@ let GenerateOptimizationData(tcConfig) = let EncodeOptimizationData(tcGlobals,tcConfig,outfile,exportRemapping,data) = if GenerateOptimizationData tcConfig then let data = map2Of2 (Optimizer.RemapOptimizationInfo tcGlobals exportRemapping) data - if verbose then dprintn "Generating optimization data attribute..."; + if verbose then dprintn "Generating optimization data attribute..." // REVIEW: need a better test for this if tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib then let ccu,modulInfo = data let bytes = TastPickle.pickleObjWithDanglingCcus outfile tcGlobals ccu Optimizer.p_CcuOptimizationInfo modulInfo let optDataFileName = (Filename.chopExtension outfile)+".optdata" - File.WriteAllBytes(optDataFileName,bytes); + File.WriteAllBytes(optDataFileName,bytes) // As with the sigdata file, the optdata gets written to a file for FSharp.Core if tcGlobals.compilingFslib then [] @@ -729,7 +728,7 @@ module VersionResourceFormat = open BinaryGenerationUtilities let VersionInfoNode(data:byte[]) = - [| yield! i16 (data.Length + 2) // wLength : int16; // Specifies the length, in bytes, of the VS_VERSION_INFO structure. This length does not include any padding that aligns any subsequent version resource data on a 32-bit boundary. + [| yield! i16 (data.Length + 2) // wLength : int16 // Specifies the length, in bytes, of the VS_VERSION_INFO structure. This length does not include any padding that aligns any subsequent version resource data on a 32-bit boundary. yield! data |] let VersionInfoElement(wType, szKey, valueOpt: byte[] option, children:byte[][], isString) = @@ -737,7 +736,7 @@ module VersionResourceFormat = let wValueLength = (match valueOpt with None -> 0 | Some value -> (if isString then value.Length / 2 else value.Length)) VersionInfoNode [| yield! i16 wValueLength // wValueLength: int16. Specifies the length, in words, of the Value member. This value is zero if there is no Value member associated with the current version structure. - yield! i16 wType // wType : int16; Specifies the type of data in the version resource. This member is 1 if the version resource contains text data and 0 if the version resource contains binary data. + yield! i16 wType // wType : int16 Specifies the type of data in the version resource. This member is 1 if the version resource contains text data and 0 if the version resource contains binary data. yield! Padded 2 szKey match valueOpt with | None -> yield! [] @@ -746,8 +745,8 @@ module VersionResourceFormat = yield! child |] let Version((v1,v2,v3,v4):ILVersionInfo) = - [| yield! i32 (int32 v1 <<< 16 ||| int32 v2) // DWORD dwFileVersionMS; // Specifies the most significant 32 bits of the file's binary version number. This member is used with dwFileVersionLS to form a 64-bit value used for numeric comparisons. - yield! i32 (int32 v3 <<< 16 ||| int32 v4) // DWORD dwFileVersionLS; // Specifies the least significant 32 bits of the file's binary version number. This member is used with dwFileVersionMS to form a 64-bit value used for numeric comparisons. + [| yield! i32 (int32 v1 <<< 16 ||| int32 v2) // DWORD dwFileVersionMS // Specifies the most significant 32 bits of the file's binary version number. This member is used with dwFileVersionLS to form a 64-bit value used for numeric comparisons. + yield! i32 (int32 v3 <<< 16 ||| int32 v4) // DWORD dwFileVersionLS // Specifies the least significant 32 bits of the file's binary version number. This member is used with dwFileVersionMS to form a 64-bit value used for numeric comparisons. |] let String(string,value) = @@ -793,12 +792,12 @@ module VersionResourceFormat = dwFileType,dwFileSubtype, lwFileDate:int64) = let dwStrucVersion = 0x00010000 - [| yield! i32 0xFEEF04BD // DWORD dwSignature; // Contains the value 0xFEEFO4BD. This is used with the szKey member of the VS_VERSION_INFO structure when searching a file for the VS_FIXEDFILEINFO structure. - yield! i32 dwStrucVersion // DWORD dwStrucVersion; // Specifies the binary version number of this structure. The high-order word of this member contains the major version number, and the low-order word contains the minor version number. - yield! Version fileVersion // DWORD dwFileVersionMS,dwFileVersionLS; // Specifies the most/least significant 32 bits of the file's binary version number. This member is used with dwFileVersionLS to form a 64-bit value used for numeric comparisons. - yield! Version productVersion // DWORD dwProductVersionMS,dwProductVersionLS; // Specifies the most/least significant 32 bits of the file's binary version number. This member is used with dwFileVersionLS to form a 64-bit value used for numeric comparisons. - yield! i32 dwFileFlagsMask // DWORD dwFileFlagsMask; // Contains a bitmask that specifies the valid bits in dwFileFlags. A bit is valid only if it was defined when the file was created. - yield! i32 dwFileFlags // DWORD dwFileFlags; // Contains a bitmask that specifies the Boolean attributes of the file. This member can include one or more of the following values: + [| yield! i32 0xFEEF04BD // DWORD dwSignature // Contains the value 0xFEEFO4BD. This is used with the szKey member of the VS_VERSION_INFO structure when searching a file for the VS_FIXEDFILEINFO structure. + yield! i32 dwStrucVersion // DWORD dwStrucVersion // Specifies the binary version number of this structure. The high-order word of this member contains the major version number, and the low-order word contains the minor version number. + yield! Version fileVersion // DWORD dwFileVersionMS,dwFileVersionLS // Specifies the most/least significant 32 bits of the file's binary version number. This member is used with dwFileVersionLS to form a 64-bit value used for numeric comparisons. + yield! Version productVersion // DWORD dwProductVersionMS,dwProductVersionLS // Specifies the most/least significant 32 bits of the file's binary version number. This member is used with dwFileVersionLS to form a 64-bit value used for numeric comparisons. + yield! i32 dwFileFlagsMask // DWORD dwFileFlagsMask // Contains a bitmask that specifies the valid bits in dwFileFlags. A bit is valid only if it was defined when the file was created. + yield! i32 dwFileFlags // DWORD dwFileFlags // Contains a bitmask that specifies the Boolean attributes of the file. This member can include one or more of the following values: // VS_FF_DEBUG 0x1L The file contains debugging information or is compiled with debugging features enabled. // VS_FF_INFOINFERRED The file's version structure was created dynamically; therefore, some of the members in this structure may be empty or incorrect. This flag should never be set in a file's VS_VERSION_INFO data. // VS_FF_PATCHED The file has been modified and is not identical to the original shipping file of the same version number. @@ -907,7 +906,7 @@ module AttributeHelpers = | Some versionString -> try Some(IL.parseILVersion versionString) with e -> - warning(Error(FSComp.SR.fscBadAssemblyVersion(attribName, versionString),Range.rangeStartup)); + warning(Error(FSComp.SR.fscBadAssemblyVersion(attribName, versionString),Range.rangeStartup)) None | _ -> None @@ -927,27 +926,27 @@ let injectedCompatTypes = "System.Collections.IStructuralEquatable" ] let typesForwardedToMscorlib = - set [ "System.AggregateException"; - "System.Threading.CancellationTokenRegistration"; - "System.Threading.CancellationToken"; - "System.Threading.CancellationTokenSource"; - "System.Lazy`1"; - "System.IObservable`1"; - "System.IObserver`1"; + set [ "System.AggregateException" + "System.Threading.CancellationTokenRegistration" + "System.Threading.CancellationToken" + "System.Threading.CancellationTokenSource" + "System.Lazy`1" + "System.IObservable`1" + "System.IObserver`1" ] let typesForwardedToSystemNumerics = - set [ "System.Numerics.BigInteger"; ] + set [ "System.Numerics.BigInteger" ] let createMscorlibExportList tcGlobals = // We want to write forwarders out for all injected types except for System.ITuple, which is internal // Forwarding System.ITuple will cause FxCop failures on 4.0 Set.union (Set.filter (fun t -> t <> "System.ITuple") injectedCompatTypes) typesForwardedToMscorlib |> Seq.map (fun t -> - { ScopeRef = tcGlobals.sysCcu.ILScopeRef ; - Name = t ; - IsForwarder = true ; - Access = ILTypeDefAccess.Public ; - Nested = mkILNestedExportedTypes List.empty ; + { ScopeRef = tcGlobals.sysCcu.ILScopeRef + Name = t + IsForwarder = true + Access = ILTypeDefAccess.Public + Nested = mkILNestedExportedTypes List.empty CustomAttrs = mkILCustomAttrs List.empty }) |> Seq.toList @@ -957,10 +956,10 @@ let createSystemNumericsExportList tcGlobals = typesForwardedToSystemNumerics |> Seq.map (fun t -> { ScopeRef = ILScopeRef.Assembly(systemNumericsAssemblyRef) - Name = t; - IsForwarder = true ; - Access = ILTypeDefAccess.Public ; - Nested = mkILNestedExportedTypes List.empty ; + Name = t + IsForwarder = true + Access = ILTypeDefAccess.Public + Nested = mkILNestedExportedTypes List.empty CustomAttrs = mkILCustomAttrs List.empty }) |> Seq.toList @@ -1005,7 +1004,7 @@ module MainModuleBuilder = codegenResults,assemVerFromAttrib,metadataVersion,secDecls) = - if !progress then dprintf "Creating main module...\n"; + if !progress then dprintf "Creating main module...\n" let ilTypeDefs = //let topTypeDef = mkILTypeDefForGlobalFunctions tcGlobals.ilg (mkILMethods [], emptyILFields) mkILTypeDefs codegenResults.ilTypeDefs @@ -1039,9 +1038,9 @@ module MainModuleBuilder = | QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus -> [ ] let reflectedDefinitionResource = - { Name=reflectedDefinitionResourceName; - Location = ILResourceLocation.Local (fun () -> reflectedDefinitionBytes); - Access= ILResourceAccess.Public; + { Name=reflectedDefinitionResourceName + Location = ILResourceLocation.Local (fun () -> reflectedDefinitionBytes) + Access= ILResourceAccess.Public CustomAttrs = emptyILCustomAttrs } reflectedDefinitionAttrs, reflectedDefinitionResource) |> List.unzip @@ -1067,9 +1066,9 @@ module MainModuleBuilder = match assemVerFromAttrib with | None -> tcVersion | Some v -> v - Some { man with Version= Some ver; - CustomAttrs = manifestAttrs; - DisableJitOptimizations=disableJitOptimizations; + Some { man with Version= Some ver + CustomAttrs = manifestAttrs + DisableJitOptimizations=disableJitOptimizations SecurityDecls=secDecls } let resources = @@ -1091,7 +1090,7 @@ module MainModuleBuilder = let writeResources((r:(string * obj) list),(f:string)) = use writer = new System.Resources.ResourceWriter(f) r |> List.iter (fun (k,v) -> writer.AddResource(k,v)) - writeResources(readResX(file),outfile); + writeResources(readResX(file),outfile) let file,name,pub = TcConfigBuilder.SplitCommandLineResourceInfo outfile let file = tcConfig.ResolveSourceFile(rangeStartup,file,tcConfig.implicitIncludeDir) let bytes = FileSystem.ReadAllBytesShim file @@ -1103,9 +1102,9 @@ module MainModuleBuilder = let file = tcConfig.ResolveSourceFile(rangeStartup,file,tcConfig.implicitIncludeDir) let bytes = FileSystem.ReadAllBytesShim file name,bytes,pub - yield { Name=name; - Location=ILResourceLocation.Local (fun () -> bytes); - Access=pub; + yield { Name=name + Location=ILResourceLocation.Local (fun () -> bytes) + Access=pub CustomAttrs=emptyILCustomAttrs } yield! reflectedDefinitionResources @@ -1113,9 +1112,9 @@ module MainModuleBuilder = yield! optDataResources for ri in tcConfig.linkResources do let file,name,pub = TcConfigBuilder.SplitCommandLineResourceInfo ri - yield { Name=name; - Location=ILResourceLocation.File(ILModuleRef.Create(name=file, hasMetadata=false, hash=Some (sha1HashBytes (FileSystem.ReadAllBytesShim file))), 0); - Access=pub; + yield { Name=name + Location=ILResourceLocation.File(ILModuleRef.Create(name=file, hasMetadata=false, hash=Some (sha1HashBytes (FileSystem.ReadAllBytesShim file))), 0) + Access=pub CustomAttrs=emptyILCustomAttrs } ] let assemblyVersion = @@ -1208,7 +1207,7 @@ module MainModuleBuilder = // a user cannot specify both win32res and win32manifest if not(tcConfig.win32manifest = "") && not(tcConfig.win32res = "") then - error(Error(FSComp.SR.fscTwoResourceManifests(),rangeCmdArgs)); + error(Error(FSComp.SR.fscTwoResourceManifests(),rangeCmdArgs)) let win32Manifest = // use custom manifest if provided @@ -1234,32 +1233,28 @@ module MainModuleBuilder = yield Lazy<_>.CreateFromValue av if not(tcConfig.win32res = "") then yield Lazy<_>.CreateFromValue (FileSystem.ReadAllBytesShim tcConfig.win32res) -#if ENABLE_MONO_SUPPORT - if tcConfig.includewin32manifest && not(win32Manifest = "") && not(runningOnMono) then -#else - if tcConfig.includewin32manifest && not(win32Manifest = "") then -#endif + if tcConfig.includewin32manifest && not(win32Manifest = "") && not runningOnMono then yield Lazy<_>.CreateFromValue [| yield! ResFileFormat.ResFileHeader() yield! (ManifestResourceFormat.VS_MANIFEST_RESOURCE((FileSystem.ReadAllBytesShim win32Manifest), tcConfig.target = Dll)) |]] // Add attributes, version number, resources etc. {mainModule with StackReserveSize = tcConfig.stackReserveSize - Name = (if tcConfig.target = Module then Filename.fileNameOfPath outfile else mainModule.Name); - SubSystemFlags = (if tcConfig.target = WinExe then 2 else 3) ; - Resources= resources; - ImageBase = (match tcConfig.baseAddress with None -> 0x00400000l | Some b -> b); - IsDLL=(tcConfig.target = Dll || tcConfig.target=Module); - Platform = tcConfig.platform ; - Is32Bit=(match tcConfig.platform with Some X86 -> true | _ -> false); - Is64Bit=(match tcConfig.platform with Some AMD64 | Some IA64 -> true | _ -> false); - Is32BitPreferred = if tcConfig.prefer32Bit && not tcConfig.target.IsExe then (error(Error(FSComp.SR.invalidPlatformTarget(),rangeCmdArgs))) else tcConfig.prefer32Bit; + Name = (if tcConfig.target = Module then Filename.fileNameOfPath outfile else mainModule.Name) + SubSystemFlags = (if tcConfig.target = WinExe then 2 else 3) + Resources= resources + ImageBase = (match tcConfig.baseAddress with None -> 0x00400000l | Some b -> b) + IsDLL=(tcConfig.target = Dll || tcConfig.target=Module) + Platform = tcConfig.platform + Is32Bit=(match tcConfig.platform with Some X86 -> true | _ -> false) + Is64Bit=(match tcConfig.platform with Some AMD64 | Some IA64 -> true | _ -> false) + Is32BitPreferred = if tcConfig.prefer32Bit && not tcConfig.target.IsExe then (error(Error(FSComp.SR.invalidPlatformTarget(),rangeCmdArgs))) else tcConfig.prefer32Bit CustomAttrs= mkILCustomAttrs [ if tcConfig.target = Module then yield! iattrs - yield! codegenResults.ilNetModuleAttrs ]; - NativeResources=nativeResources; + yield! codegenResults.ilNetModuleAttrs ] + NativeResources=nativeResources Manifest = manifest } @@ -1276,7 +1271,7 @@ module StaticLinker = // Check no dependent assemblies use quotations let dependentCcuUsingQuotations = dependentILModules |> List.tryPick (function (Some ccu,_) when ccu.UsesFSharp20PlusQuotations -> Some ccu | _ -> None) match dependentCcuUsingQuotations with - | Some ccu -> error(Error(FSComp.SR.fscQuotationLiteralsStaticLinking(ccu.AssemblyName),rangeStartup)); + | Some ccu -> error(Error(FSComp.SR.fscQuotationLiteralsStaticLinking(ccu.AssemblyName),rangeStartup)) | None -> () // Check we're not static linking a .EXE @@ -1360,10 +1355,10 @@ module StaticLinker = let ilxMainModule = { ilxMainModule with - Manifest = (let m = ilxMainModule.ManifestOfAssembly in Some {m with CustomAttrs = mkILCustomAttrs (m.CustomAttrs.AsList @ savedManifestAttrs) }); - CustomAttrs = mkILCustomAttrs [ for m in moduls do yield! m.CustomAttrs.AsList ]; - TypeDefs = mkILTypeDefs (topTypeDef :: List.concat normalTypeDefs); - Resources = mkILResources (savedResources @ ilxMainModule.Resources.AsList); + Manifest = (let m = ilxMainModule.ManifestOfAssembly in Some {m with CustomAttrs = mkILCustomAttrs (m.CustomAttrs.AsList @ savedManifestAttrs) }) + CustomAttrs = mkILCustomAttrs [ for m in moduls do yield! m.CustomAttrs.AsList ] + TypeDefs = mkILTypeDefs (topTypeDef :: List.concat normalTypeDefs) + Resources = mkILResources (savedResources @ ilxMainModule.Resources.AsList) NativeResources = savedNativeResources } ilxMainModule, rewriteExternalRefsToLocalRefs @@ -1379,8 +1374,8 @@ module StaticLinker = let ilBinaryReader = let ilGlobals = mkILGlobals (IL.mkMscorlibBasedTraits ILScopeRef.Local) (Some ilGlobals.primaryAssemblyName) tcConfig.noDebugData let opts = { ILBinaryReader.mkDefault (ilGlobals) with - optimizeForMemory=tcConfig.optimizeForMemory; - pdbPath = None; } + optimizeForMemory=tcConfig.optimizeForMemory + pdbPath = None } ILBinaryReader.OpenILModuleReader mscorlib40 opts let tdefs1 = ilxMainModule.TypeDefs.AsList |> List.filter (fun td -> not (injectedCompatTypes.Contains(td.Name))) @@ -1420,16 +1415,16 @@ module StaticLinker = let ilxMainModule = { ilxMainModule with - TypeDefs = mkILTypeDefs (tdefs1 @ tdefs2); } + TypeDefs = mkILTypeDefs (tdefs1 @ tdefs2) } ilxMainModule [] type Node = - { name: string; - data: ILModuleDef; - ccu: option; - refs: ILReferences; - mutable edges: list; + { name: string + data: ILModuleDef + ccu: option + refs: ILReferences + mutable edges: list mutable visited: bool } // Find all IL modules that are to be statically linked given the static linking roots. @@ -1440,11 +1435,11 @@ module StaticLinker = // Recursively find all referenced modules and add them to a module graph let depModuleTable = HashMultiMap(0, HashIdentity.Structural) let dummyEntry nm = - { refs = IL.emptyILRefs ; - name=nm; - ccu=None; - data=ilxMainModule; // any old module - edges = []; + { refs = IL.emptyILRefs + name=nm + ccu=None + data=ilxMainModule // any old module + edges = [] visited = true } let assumedIndependentSet = set [ "mscorlib"; "System"; "System.Core"; "System.Xml"; "Microsoft.Build.Framework"; "Microsoft.Build.Utilities" ] @@ -1452,7 +1447,7 @@ module StaticLinker = let remaining = ref (computeILRefs ilxMainModule).AssemblyReferences while nonNil !remaining do let ilAssemRef = List.head !remaining - remaining := List.tail !remaining; + remaining := List.tail !remaining if assumedIndependentSet.Contains ilAssemRef.Name || (ilAssemRef.PublicKey = Some ecmaPublicKey) then depModuleTable.[ilAssemRef.Name] <- dummyEntry ilAssemRef.Name else @@ -1473,27 +1468,27 @@ module StaticLinker = warning(Error(FSComp.SR.fscIgnoringMixedWhenLinking ilAssemRef.Name,rangeStartup)) IL.emptyILRefs else - { AssemblyReferences = dllInfo.ILAssemblyRefs; + { AssemblyReferences = dllInfo.ILAssemblyRefs ModuleReferences = [] } depModuleTable.[ilAssemRef.Name] <- - { refs=refs; - name=ilAssemRef.Name; - ccu=ccu; - data=modul; - edges = []; - visited = false }; + { refs=refs + name=ilAssemRef.Name + ccu=ccu + data=modul + edges = [] + visited = false } // Push the new work items - remaining := refs.AssemblyReferences @ !remaining; + remaining := refs.AssemblyReferences @ !remaining | None -> - warning(Error(FSComp.SR.fscAssumeStaticLinkContainsNoDependencies(ilAssemRef.Name),rangeStartup)); + warning(Error(FSComp.SR.fscAssumeStaticLinkContainsNoDependencies(ilAssemRef.Name),rangeStartup)) depModuleTable.[ilAssemRef.Name] <- dummyEntry ilAssemRef.Name - done; - end; + done + end - ReportTime tcConfig "Find dependencies"; + ReportTime tcConfig "Find dependencies" // Add edges from modules to the modules that depend on them for (KeyValue(_,n)) in depModuleTable do @@ -1508,18 +1503,18 @@ module StaticLinker = for n in tcConfig.extraStaticLinkRoots do match depModuleTable.TryFind n with | Some x -> yield x - | None -> error(Error(FSComp.SR.fscAssemblyNotFoundInDependencySet(n),rangeStartup)); + | None -> error(Error(FSComp.SR.fscAssemblyNotFoundInDependencySet(n),rangeStartup)) ] let remaining = ref roots [ while nonNil !remaining do let n = List.head !remaining - remaining := List.tail !remaining; + remaining := List.tail !remaining if not n.visited then - if verbose then dprintn ("Module "+n.name+" depends on "+GetFSharpCoreLibraryName()); - n.visited <- true; + if verbose then dprintn ("Module "+n.name+" depends on "+GetFSharpCoreLibraryName()) + n.visited <- true remaining := n.edges @ !remaining - yield (n.ccu, n.data); ] + yield (n.ccu, n.data) ] // Add all provider-generated assemblies into the static linking set let FindProviderGeneratedILModules (tcImports:TcImports, providerGeneratedAssemblies: (ImportedBinary * _) list) = @@ -1563,11 +1558,11 @@ module StaticLinker = (fun ilxMainModule -> ilxMainModule) else (fun ilxMainModule -> - ReportTime tcConfig "Find assembly references"; + ReportTime tcConfig "Find assembly references" let dependentILModules = FindDependentILModulesForStaticLinking (tcConfig, tcImports,ilxMainModule) - ReportTime tcConfig "Static link"; + ReportTime tcConfig "Static link" #if EXTENSIONTYPING Morphs.enableMorphCustomAttributeData() @@ -1606,7 +1601,7 @@ module StaticLinker = // Build a dictionary of all IL type defs, mapping ilOrigTyRef --> ilTypeDef let allTypeDefsInProviderGeneratedAssemblies = let rec loop ilOrigTyRef (ilTypeDef:ILTypeDef) = - seq { yield (ilOrigTyRef,ilTypeDef); + seq { yield (ilOrigTyRef,ilTypeDef) for ntdef in ilTypeDef.NestedTypes do yield! loop (mkILTyRefInTyRef (ilOrigTyRef, ntdef.Name)) ntdef } dict [ @@ -1741,7 +1736,7 @@ let GetSigner signingInfo = module FileWriter = let EmitIL (tcConfig:TcConfig, ilGlobals, errorLogger:ErrorLogger, outfile, pdbfile, ilxMainModule, signingInfo:SigningInfo, exiter:Exiter) = try - if !progress then dprintn "Writing assembly..."; + if !progress then dprintn "Writing assembly..." try ILBinaryWriter.WriteILBinary (outfile, @@ -1774,7 +1769,7 @@ let ValidateKeySigningAttributes (tcConfig : TcConfig,tcGlobals,topAttrs) = match delaySignAttrib with | Some delaysign -> if tcConfig.delaysign then - warning(Error(FSComp.SR.fscDelaySignWarning(),rangeCmdArgs)) ; + warning(Error(FSComp.SR.fscDelaySignWarning(),rangeCmdArgs)) tcConfig.delaysign else delaysign @@ -1785,7 +1780,7 @@ let ValidateKeySigningAttributes (tcConfig : TcConfig,tcGlobals,topAttrs) = match signerAttrib with | Some signer -> if tcConfig.signer.IsSome && tcConfig.signer <> Some signer then - warning(Error(FSComp.SR.fscKeyFileWarning(),rangeCmdArgs)) ; + warning(Error(FSComp.SR.fscKeyFileWarning(),rangeCmdArgs)) tcConfig.signer else Some signer @@ -1798,7 +1793,7 @@ let ValidateKeySigningAttributes (tcConfig : TcConfig,tcGlobals,topAttrs) = match containerAttrib with | Some container -> if tcConfig.container.IsSome && tcConfig.container <> Some container then - warning(Error(FSComp.SR.fscKeyNameWarning(),rangeCmdArgs)) ; + warning(Error(FSComp.SR.fscKeyNameWarning(),rangeCmdArgs)) tcConfig.container else Some container @@ -1922,9 +1917,9 @@ let main1(tcGlobals, tcImports: TcImports, frameworkTcImports, generatedCcu, typ // write interface, xmldoc begin - ReportTime tcConfig ("Write Interface File"); + ReportTime tcConfig ("Write Interface File") use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Output) - if tcConfig.printSignature then InterfaceFileWriter.WriteInterfaceFile (tcGlobals,tcConfig, InfoReader(tcGlobals,tcImports.GetImportMap()), typedAssembly); + if tcConfig.printSignature then InterfaceFileWriter.WriteInterfaceFile (tcGlobals,tcConfig, InfoReader(tcGlobals,tcImports.GetImportMap()), typedAssembly) ReportTime tcConfig ("Write XML document signatures") if tcConfig.xmlDocOutputFile.IsSome then XmlDocWriter.computeXmlDocSigs (tcGlobals,generatedCcu) @@ -1944,7 +1939,7 @@ let main1(tcGlobals, tcImports: TcImports, frameworkTcImports, generatedCcu, typ let main2(Args(tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, errorLogger: ErrorLogger, generatedCcu: CcuThunk, outfile, typedAssembly, topAttrs, pdbfile, assemblyName, assemVerFromAttrib, signingInfo, exiter: Exiter)) = - ReportTime tcConfig ("Encode Interface Data"); + ReportTime tcConfig ("Encode Interface Data") let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents let sigDataAttributes,sigDataResources = @@ -1956,7 +1951,7 @@ let main2(Args(tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, er exiter.Exit 1 if !progress && tcConfig.optSettings.jitOptUser = Some false then - dprintf "Note, optimizations are off.\n"; + dprintf "Note, optimizations are off.\n" (* optimize *) use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Optimize) @@ -1971,7 +1966,7 @@ let main2(Args(tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, er AbortOnError(errorLogger,tcConfig,exiter) - ReportTime tcConfig ("Encoding OptData"); + ReportTime tcConfig ("Encoding OptData") let optDataResources = EncodeOptimizationData(tcGlobals,tcConfig,outfile,exportRemapping,(generatedCcu,optimizationData)) let sigDataResources, _optimizationData = @@ -2002,10 +1997,10 @@ let main2b(Args(tcConfig: TcConfig, tcImports, tcGlobals, errorLogger, generated // Compute a static linker. let ilGlobals = tcGlobals.ilg if tcConfig.standalone && generatedCcu.UsesFSharp20PlusQuotations then - error(Error(FSComp.SR.fscQuotationLiteralsStaticLinking0(),rangeStartup)); + error(Error(FSComp.SR.fscQuotationLiteralsStaticLinking0(),rangeStartup)) let staticLinker = StaticLinker.StaticLink (tcConfig,tcImports,ilGlobals) - ReportTime tcConfig "TAST -> ILX"; + ReportTime tcConfig "TAST -> ILX" use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.IlxGen) let ilxGenerator = CreateIlxAssemblyGenerator (tcConfig,tcImports,tcGlobals, (LightweightTcValForUsingInBuildMethodCall tcGlobals), generatedCcu) diff --git a/src/fsharp/fsharp.core.netcore.nuget/Microsoft.FSharp.Core.netcore.nuspec b/src/fsharp/fsharp.core.netcore.nuget/Microsoft.FSharp.Core.netcore.nuspec index ddcb33421ab..f4dcefd9a8c 100644 --- a/src/fsharp/fsharp.core.netcore.nuget/Microsoft.FSharp.Core.netcore.nuspec +++ b/src/fsharp/fsharp.core.netcore.nuget/Microsoft.FSharp.Core.netcore.nuspec @@ -3,8 +3,8 @@ Microsoft.FSharp.Core.netcore - netcore compatible version of the fsharp core library fsharp.core.dll - Supported Platforms: - .NET Core (netstandard1.5) + .NET Core compatible version of the fsharp core library fsharp.core.dll + Supported Platforms: - .NET Core (netstandard1.6) en-US true @@ -14,28 +14,28 @@ $projectUrl$ $tags$ - - - - - - - - - - - - + + + + + + + + + + + + - - - - - - + + + + + + diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 0e5ded12cc6..d662bf4f1a4 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -835,11 +835,7 @@ type internal FsiDynamicCompiler errorLogger.AbortOnError(); let fragName = textOfLid prefixPath -#if ENABLE_MONO_SUPPORT let codegenResults = GenerateIlxCode (IlReflectBackend, isInteractiveItExpr, runningOnMono, tcConfig, topCustomAttrs, optimizedImpls, fragName, true, ilxGenerator) -#else - let codegenResults = GenerateIlxCode (IlReflectBackend, isInteractiveItExpr, false, tcConfig, topCustomAttrs, optimizedImpls, fragName, true, ilxGenerator) -#endif errorLogger.AbortOnError(); // Each input is like a small separately compiled extension to a single source file. @@ -2229,7 +2225,7 @@ type internal FsiEvaluationSession (argv:string[], inReader:TextReader, outWrite do tcConfigB.useFsiAuxLib <- true #if TODO_REWORK_ASSEMBLY_LOAD - do tcConfigB.useMonoResolution<-true + do tcConfigB.useSimpleResolution<-true #else #endif @@ -2250,7 +2246,7 @@ type internal FsiEvaluationSession (argv:string[], inReader:TextReader, outWrite do InstallErrorLoggingOnThisThread errorLogger // FSI error logging on main thread. let updateBannerText() = - tcConfigB.productNameForBannerText <- FSIstrings.SR.fsiProductName(FSharpEnvironment.DotNetBuildString) + tcConfigB.productNameForBannerText <- FSIstrings.SR.fsiProductName(FSharpEnvironment.FSharpBannerVersion) do updateBannerText() // setting the correct banner so that 'fsi -?' display the right thing diff --git a/src/fsharp/fsi/project.json b/src/fsharp/fsi/project.json index 824fba60719..d32dabdd033 100644 --- a/src/fsharp/fsi/project.json +++ b/src/fsharp/fsi/project.json @@ -1,22 +1,22 @@ { "dependencies": { - "Microsoft.NETCore.Platforms": "1.0.1-rc2-24027", - "NETStandard.Library": "1.5.0-rc2-24027", - "System.Diagnostics.Process": "4.1.0-rc2-24027", - "System.Linq.Expressions": "4.0.11-rc2-24027", - "System.Reflection.Emit": "4.0.1-rc2-24027", - "System.Reflection.TypeExtensions": "4.1.0-rc2-24027", - "System.Runtime.Loader": "4.0.0-rc2-24027", - "System.Threading.Thread": "4.0.0-rc2-24027", - "System.Reflection.Metadata": "1.3.0-rc2-24027", + "Microsoft.NETCore.Platforms": "1.0.1", + "NETStandard.Library": "1.6.0", + "System.Diagnostics.Process": "4.1.0", + "System.Linq.Expressions": "4.1.0", + "System.Reflection.Emit": "4.0.1", + "System.Reflection.TypeExtensions": "4.1.0", + "System.Runtime.Loader": "4.0.0", + "System.Threading.Thread": "4.0.0", + "System.Reflection.Metadata": "1.4.1-beta-24227-04" }, "runtimes": { "win7-x86": { }, "win7-x64": { }, - "osx.10.10-x64": { }, + "osx.10.11-x64": { }, "ubuntu.14.04-x64": { } }, "frameworks": { - "netstandard1.5": { } + "netstandard1.6": { } } } diff --git a/src/fsharp/fsiaux.fs b/src/fsharp/fsiaux.fs index b3651de4ddb..1fbeeef15f3 100644 --- a/src/fsharp/fsiaux.fs +++ b/src/fsharp/fsiaux.fs @@ -31,34 +31,34 @@ type internal SimpleEventLoop() = let restart = ref false interface IEventLoop with member x.Run() = - running := true; + running := true let rec run() = match waitSignal2 runSignal exitSignal with | 0 -> - !queue |> List.iter (fun f -> result := try Some(f()) with _ -> None); - setSignal doneSignal; + !queue |> List.iter (fun f -> result := try Some(f()) with _ -> None) + setSignal doneSignal run() | 1 -> - running := false; + running := false !restart | _ -> run() - run(); + run() member x.Invoke(f : unit -> 'T) : 'T = - queue := [f >> box]; - setSignal runSignal; + queue := [f >> box] + setSignal runSignal waitSignal doneSignal !result |> Option.get |> unbox member x.ScheduleRestart() = // nb. very minor race condition here on running here, but totally // unproblematic as ScheduleRestart and Exit are almost never called. if !running then - restart := true; + restart := true setSignal exitSignal interface System.IDisposable with member x.Dispose() = - runSignal.Dispose(); - exitSignal.Dispose(); - doneSignal.Dispose(); + runSignal.Dispose() + exitSignal.Dispose() + doneSignal.Dispose() diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index 974c7e93d61..7f29cacc8ee 100644 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -162,7 +162,7 @@ let rec ImportILType (env:ImportMap) m tinst typ = ImportTyconRefApp env tcref inst | ILType.Byref ty -> mkByrefTy env.g (ImportILType env m tinst ty) - | ILType.Ptr ty -> mkNativePtrType env.g (ImportILType env m tinst ty) + | ILType.Ptr ty -> mkNativePtrTy env.g (ImportILType env m tinst ty) | ILType.FunctionPointer _ -> env.g.nativeint_ty (* failwith "cannot import this kind of type (ptr, fptr)" *) | ILType.Modified(_,_,ty) -> // All custom modifiers are ignored @@ -244,7 +244,7 @@ let rec ImportProvidedType (env:ImportMap) (m:range) (* (tinst:TypeInst) *) (st: mkByrefTy g elemTy elif st.PUntaint((fun st -> st.IsPointer),m) then let elemTy = (ImportProvidedType env m (* tinst *) (st.PApply((fun st -> st.GetElementType()),m))) - mkNativePtrType g elemTy + mkNativePtrTy g elemTy else // REVIEW: Extension type could try to be its own generic arg (or there could be a type loop) diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index 93d8287315d..67dbd720573 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -87,7 +87,7 @@ let GetSuperTypeOfType g amap m typ = Some g.obj_ty elif isTupleStructTy g typ then Some g.obj_ty - elif isRecdTy g typ then + elif isRecdTy g typ || isUnionTy g typ then Some g.obj_ty else None @@ -519,6 +519,14 @@ type OptionalArgInfo = else NotOptional +type CallerInfoInfo = + | NoCallerInfo + | CallerLineNumber + | CallerMemberName + | CallerFilePath + + override x.ToString() = sprintf "%+A" x + [] type ReflectedArgInfo = | None @@ -541,8 +549,8 @@ type ParamNameAndType = [] /// Full information about a parameter returned for use by the type checker and language service. type ParamData = - /// ParamData(isParamArray, isOut, optArgInfo, nameOpt, reflArgInfo, ttype) - ParamData of bool * bool * OptionalArgInfo * Ident option * ReflectedArgInfo * TType + /// ParamData(isParamArray, isOut, optArgInfo, callerInfoInfo, nameOpt, reflArgInfo, ttype) + ParamData of bool * bool * OptionalArgInfo * CallerInfoInfo * Ident option * ReflectedArgInfo * TType //------------------------------------------------------------------------- @@ -724,7 +732,7 @@ type ILMethInfo = let md = x.RawMetadata not md.IsConstructor && not md.IsClassInitializer && - (md.Access = ILMemberAccess.Family) + (md.Access = ILMemberAccess.Family || md.Access = ILMemberAccess.FamilyOrAssembly) /// Indicates if the IL method is marked virtual. member x.IsVirtual = x.RawMetadata.IsVirtual @@ -1277,8 +1285,25 @@ type MethInfo = | _ -> ReflectedArgInfo.None let isOutArg = (p.IsOut && not p.IsIn) // Note: we get default argument values from VB and other .NET language metadata - let optArgInfo = OptionalArgInfo.FromILParameter g amap m ilMethInfo.MetadataScope ilMethInfo.DeclaringTypeInst p - yield (isParamArrayArg, isOutArg, optArgInfo, reflArgInfo) ] ] + let optArgInfo = OptionalArgInfo.FromILParameter g amap m ilMethInfo.MetadataScope ilMethInfo.DeclaringTypeInst p + + let isCallerLineNumberArg = TryFindILAttribute g.attrib_CallerLineNumberAttribute p.CustomAttrs + let isCallerFilePathArg = TryFindILAttribute g.attrib_CallerFilePathAttribute p.CustomAttrs + let isCallerMemberNameArg = TryFindILAttribute g.attrib_CallerMemberNameAttribute p.CustomAttrs + + let callerInfoInfo = + match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with + | false, false, false -> NoCallerInfo + | true, false, false -> CallerLineNumber + | false, true, false -> CallerFilePath + | false, false, true -> CallerMemberName + | _, _, _ -> + // if multiple caller info attributes are specified, pick the "wrong" one here + // so that we get an error later + if p.Type.TypeRef.FullName = "System.Int32" then CallerFilePath + else CallerLineNumber + + yield (isParamArrayArg, isOutArg, optArgInfo, callerInfoInfo, reflArgInfo) ] ] | FSMeth(g,_,vref,_) -> GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref @@ -1292,7 +1317,29 @@ type MethInfo = let isOptArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute argInfo.Attribs // Note: can't specify caller-side default arguments in F#, by design (default is specified on the callee-side) let optArgInfo = if isOptArg then CalleeSide else NotOptional - (isParamArrayArg, isOutArg, optArgInfo, reflArgInfo)) + + let isCallerLineNumberArg = HasFSharpAttribute g g.attrib_CallerLineNumberAttribute argInfo.Attribs + let isCallerFilePathArg = HasFSharpAttribute g g.attrib_CallerFilePathAttribute argInfo.Attribs + let isCallerMemberNameArg = HasFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs + + let callerInfoInfo = + match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with + | false, false, false -> NoCallerInfo + | true, false, false -> CallerLineNumber + | false, true, false -> CallerFilePath + | false, false, true -> CallerMemberName + | false, true, true -> match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs with + | Some(Attrib(_,_,_,_,_,_,callerMemberNameAttributeRange)) -> warning(Error(FSComp.SR.CallerMemberNameIsOverriden(argInfo.Name.Value.idText), callerMemberNameAttributeRange)) + CallerFilePath + | _ -> failwith "Impossible" + | _, _, _ -> + // if multiple caller info attributes are specified, pick the "wrong" one here + // so that we get an error later + match tryDestOptionTy g ty with + | Some optTy when typeEquiv g g.int32_ty optTy -> CallerFilePath + | _ -> CallerLineNumber + + (isParamArrayArg, isOutArg, optArgInfo, callerInfoInfo, reflArgInfo)) | DefaultStructCtor _ -> [[]] @@ -1308,7 +1355,7 @@ type MethInfo = | Some ([ Some (:? bool as b) ], _) -> ReflectedArgInfo.Quote b | Some _ -> ReflectedArgInfo.Quote false | None -> ReflectedArgInfo.None - yield (isParamArrayArg, p.PUntaint((fun p -> p.IsOut), m), optArgInfo, reflArgInfo)] ] + yield (isParamArrayArg, p.PUntaint((fun p -> p.IsOut), m), optArgInfo, NoCallerInfo, reflArgInfo)] ] #endif @@ -1407,8 +1454,8 @@ type MethInfo = #endif let paramAttribs = x.GetParamAttribs(amap, m) - (paramAttribs,paramNamesAndTypes) ||> List.map2 (List.map2 (fun (isParamArrayArg,isOutArg,optArgInfo,reflArgInfo) (ParamNameAndType(nmOpt,pty)) -> - ParamData(isParamArrayArg,isOutArg,optArgInfo,nmOpt,reflArgInfo,pty))) + (paramAttribs,paramNamesAndTypes) ||> List.map2 (List.map2 (fun (isParamArrayArg,isOutArg,optArgInfo,callerInfoInfo,reflArgInfo) (ParamNameAndType(nmOpt,pty)) -> + ParamData(isParamArrayArg,isOutArg,optArgInfo,callerInfoInfo,nmOpt,reflArgInfo,pty))) /// Select all the type parameters of the declaring type of a method. @@ -1933,7 +1980,7 @@ type PropInfo = /// Get the details of the indexer parameters associated with the property member x.GetParamDatas(amap,m) = x.GetParamNamesAndTypes(amap,m) - |> List.map (fun (ParamNameAndType(nmOpt,pty)) -> ParamData(false, false, NotOptional, nmOpt, ReflectedArgInfo.None, pty)) + |> List.map (fun (ParamNameAndType(nmOpt,pty)) -> ParamData(false, false, NotOptional, NoCallerInfo, nmOpt, ReflectedArgInfo.None, pty)) /// Get the types of the indexer parameters associated with the property member x.GetParamTypes(amap,m) = diff --git a/src/fsharp/layout.fs b/src/fsharp/layout.fs index f20e600f2ac..187211fb77c 100644 --- a/src/fsharp/layout.fs +++ b/src/fsharp/layout.fs @@ -122,11 +122,11 @@ let pushBreak saving (Breaks(next,outer,stack)) = Array.append stack (Array.create chunkN 0) (* expand if full *) else stack - stack.[next] <- saving; + stack.[next] <- saving Breaks(next+1,outer,stack) let popBreak (Breaks(next,outer,stack)) = - if next=0 then raise (Failure "popBreak: underflow"); + if next=0 then raise (Failure "popBreak: underflow") let topBroke = stack.[next-1] < 0 let outer = if outer=next then outer-1 else outer (* if all broken, unwind *) let next = next - 1 @@ -138,7 +138,7 @@ let forceBreak (Breaks(next,outer,stack)) = None else let saving = stack.[outer] - stack.[outer] <- -stack.[outer]; + stack.[outer] <- -stack.[outer] let outer = outer+1 Some (Breaks(next,outer,stack),saving) @@ -154,7 +154,7 @@ let squashTo maxWidth layout = // offset - width of last line of block // NOTE: offset <= pos -- depending on tabbing of last block let rec fit breaks (pos,layout) = - (*printf "\n\nCalling pos=%d layout=[%s]\n" pos (showL layout);*) + (*printf "\n\nCalling pos=%d layout=[%s]\n" pos (showL layout)*) let breaks,layout,pos,offset = match layout with | Attr (tag,attrs,l) -> @@ -202,7 +202,7 @@ let squashTo maxWidth layout = (* actually no saving so no break *) let breaks,r,pos,offsetr = fit breaks (pos,r) breaks,Node (jl,l,jm,r,jr,Breakable indent) ,pos,offsetl + mid + offsetr - (*printf "\nDone: pos=%d offset=%d" pos offset;*) + (*printf "\nDone: pos=%d offset=%d" pos offset*) breaks,layout,pos,offset let breaks = breaks0 () let pos = 0 diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl index 89bf263e4ba..f93eeb1bfe5 100644 --- a/src/fsharp/lex.fsl +++ b/src/fsharp/lex.fsl @@ -37,7 +37,7 @@ let lexemeTrimLeft lexbuf n = lexemeTrimBoth lexbuf n 0 let fail args (lexbuf:UnicodeLexing.Lexbuf) msg dflt = let m = lexbuf.LexemeRange - args.errorLogger.ErrorR(Error(msg,m)); + args.errorLogger.ErrorR(Error(msg,m)) dflt //-------------------------- @@ -112,7 +112,7 @@ let lexemeTrimRightToInt32 args lexbuf n = let checkExprOp (lexbuf:UnicodeLexing.Lexbuf) = if String.contains (lexeme lexbuf) ':' then - deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames(":")) lexbuf.LexemeRange; + deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames(":")) lexbuf.LexemeRange if String.contains (lexeme lexbuf) '$' then deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames("$")) lexbuf.LexemeRange @@ -125,12 +125,12 @@ let startString args (lexbuf: UnicodeLexing.Lexbuf) = let startp = lexbuf.StartPos let fin = (fun _m2 b s -> // Adjust the start-of-token mark back to the true start of the token - lexbuf.StartPos <- startp; + lexbuf.StartPos <- startp if b then if Lexhelp.stringBufferIsBytes buf then BYTEARRAY (Lexhelp.stringBufferAsBytes buf) else ( - fail args lexbuf (FSComp.SR.lexByteArrayCannotEncode()) (); + fail args lexbuf (FSComp.SR.lexByteArrayCannotEncode()) () BYTEARRAY (Lexhelp.stringBufferAsBytes buf) ) else @@ -464,7 +464,7 @@ rule token args skip = parse else WHITESPACE (LexCont.Token !args.ifdefStack) } | offwhite+ - { if args.lightSyntaxStatus.Status then errorR(Error(FSComp.SR.lexTabsNotAllowed(),lexbuf.LexemeRange)); + { if args.lightSyntaxStatus.Status then errorR(Error(FSComp.SR.lexTabsNotAllowed(),lexbuf.LexemeRange)) if not skip then (WHITESPACE (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } | "////" op_char* @@ -601,14 +601,14 @@ rule token args skip = parse | "#light" anywhite* | ("#indent" | "#light") anywhite+ "\"on\"" { if args.lightSyntaxStatus.ExplicitlySet && args.lightSyntaxStatus.WarnOnMultipleTokens then - warning(Error((0,"#light should only occur as the first non-comment text in an F# source file"),lexbuf.LexemeRange)); + warning(Error((0,"#light should only occur as the first non-comment text in an F# source file"),lexbuf.LexemeRange)) // TODO unreachable error above, I think? - brianmcn - args.lightSyntaxStatus.Status <- true; + args.lightSyntaxStatus.Status <- true if not skip then (HASH_LIGHT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } | ("#indent" | "#light") anywhite+ "\"off\"" - { args.lightSyntaxStatus.Status <- false; - mlCompatWarning (FSComp.SR.lexIndentOffForML()) lexbuf.LexemeRange; + { args.lightSyntaxStatus.Status <- false + mlCompatWarning (FSComp.SR.lexIndentOffForML()) lexbuf.LexemeRange if not skip then (HASH_LIGHT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } | anywhite* "#if" anywhite+ anystring @@ -616,7 +616,7 @@ rule token args skip = parse let lookup id = List.contains id args.defines let lexed = lexeme lexbuf let isTrue = evalIfDefExpression lexbuf.StartPos args lookup lexed - args.ifdefStack := (IfDefIf,m) :: !(args.ifdefStack); + args.ifdefStack := (IfDefIf,m) :: !(args.ifdefStack) // Get the token; make sure it starts at zero position & return let cont, f = @@ -632,7 +632,7 @@ rule token args skip = parse | (IfDefElse,_) :: _rest -> LEX_FAILURE (FSComp.SR.lexHashEndifRequiredForElse()) | (IfDefIf,_) :: rest -> let m = lexbuf.LexemeRange - args.ifdefStack := (IfDefElse,m) :: rest; + args.ifdefStack := (IfDefElse,m) :: rest let tok = HASH_ELSE(m,lexed, LexCont.EndLine(LexerEndlineContinuation.Skip(!args.ifdefStack,0,m))) let tok = shouldStartLine args lexbuf m (FSComp.SR.lexHashElseMustBeFirst()) tok if not skip then tok else endline (LexerEndlineContinuation.Skip(!args.ifdefStack,0,m)) args skip lexbuf } @@ -643,7 +643,7 @@ rule token args skip = parse match !(args.ifdefStack) with | []-> LEX_FAILURE (FSComp.SR.lexHashEndingNoMatchingIf()) | _ :: rest -> - args.ifdefStack := rest; + args.ifdefStack := rest let tok = HASH_ENDIF(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(!args.ifdefStack))) let tok = shouldStartLine args lexbuf m (FSComp.SR.lexHashEndifMustBeFirst()) tok if not skip then tok else endline (LexerEndlineContinuation.Token(!args.ifdefStack)) args skip lexbuf } @@ -684,7 +684,7 @@ and ifdefSkip n m args skip = parse | (IfDefElse,_) :: _rest -> LEX_FAILURE (FSComp.SR.lexHashEndifRequiredForElse()) | (IfDefIf,_) :: rest -> let m = lexbuf.LexemeRange - args.ifdefStack := (IfDefElse,m) :: rest; + args.ifdefStack := (IfDefElse,m) :: rest if not skip then (HASH_ELSE(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(!args.ifdefStack)))) else endline (LexerEndlineContinuation.Token(!args.ifdefStack)) args skip lexbuf else if not skip then (INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(!args.ifdefStack,n,m)))) else endline (LexerEndlineContinuation.Skip(!args.ifdefStack,n,m)) args skip lexbuf } @@ -700,7 +700,7 @@ and ifdefSkip n m args skip = parse match !(args.ifdefStack) with | [] -> LEX_FAILURE (FSComp.SR.lexHashEndingNoMatchingIf()) | _ :: rest -> - args.ifdefStack := rest; + args.ifdefStack := rest if not skip then (HASH_ENDIF(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(!args.ifdefStack)))) else endline (LexerEndlineContinuation.Token(!args.ifdefStack)) args skip lexbuf else let tok = INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(!args.ifdefStack,n-1,m))) @@ -723,7 +723,7 @@ and ifdefSkip n m args skip = parse // or end of file and then calls the lexing function specified by 'cont' - either token or ifdefSkip and endline cont args skip = parse | newline - { newline lexbuf; + { newline lexbuf match cont with | LexerEndlineContinuation.Token(ifdefStack) -> if not skip then (WHITESPACE(LexCont.Token ifdefStack)) else token args skip lexbuf | LexerEndlineContinuation.Skip(ifdefStack, n, m) -> if not skip then (INACTIVECODE (LexCont.IfDefSkip(ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf @@ -741,28 +741,28 @@ and endline cont args skip = parse and string sargs skip = parse | '\\' newline anywhite* { let (_buf,_fin,m,args) = sargs - newline lexbuf; + newline lexbuf if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } | escape_char { let (buf,_fin,m,args) = sargs - addByteChar buf (escape (lexeme lexbuf).[1]); + addByteChar buf (escape (lexeme lexbuf).[1]) if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } | trigraph { let (buf,_fin,m,args) = sargs let s = lexeme lexbuf - addByteChar buf (trigraph s.[1] s.[2] s.[3]); + addByteChar buf (trigraph s.[1] s.[2] s.[3]) if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } | hexGraphShort { let (buf,_fin,m,args) = sargs - addUnicodeChar buf (int (hexGraphShort (lexemeTrimLeft lexbuf 2))); + addUnicodeChar buf (int (hexGraphShort (lexemeTrimLeft lexbuf 2))) if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } | unicodeGraphShort { let (buf,_fin,m,args) = sargs - addUnicodeChar buf (int (unicodeGraphShort (lexemeTrimLeft lexbuf 2))); + addUnicodeChar buf (int (unicodeGraphShort (lexemeTrimLeft lexbuf 2))) if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } | unicodeGraphLong @@ -792,24 +792,24 @@ and string sargs skip = parse | newline { let (buf,_fin,m,args) = sargs - newline lexbuf; - addUnicodeString buf (lexeme lexbuf); + newline lexbuf + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } | ident { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } | integer | xinteger { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } | anywhite + { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } | eof @@ -818,13 +818,13 @@ and string sargs skip = parse | surrogateChar surrogateChar // surrogate code points always come in pairs | _ { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } and verbatimString sargs skip = parse | '"' '"' { let (buf,_fin,m,args) = sargs - addByteChar buf '\"'; + addByteChar buf '\"' if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } | '"' @@ -839,24 +839,24 @@ and verbatimString sargs skip = parse | newline { let (buf,_fin,m,args) = sargs - newline lexbuf; - addUnicodeString buf (lexeme lexbuf); + newline lexbuf + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } | ident { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } | integer | xinteger { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } | anywhite + { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } | eof @@ -865,7 +865,7 @@ and verbatimString sargs skip = parse | surrogateChar surrogateChar // surrogate code points always come in pairs | _ { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } and tripleQuoteString sargs skip = parse @@ -876,25 +876,25 @@ and tripleQuoteString sargs skip = parse | newline { let (buf,_fin,m,args) = sargs - newline lexbuf; - addUnicodeString buf (lexeme lexbuf); + newline lexbuf + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } // The rest is to break into pieces to allow double-click-on-word and other such things | ident { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } | integer | xinteger { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } | anywhite + { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } | eof @@ -903,15 +903,15 @@ and tripleQuoteString sargs skip = parse | surrogateChar surrogateChar // surrogate code points always come in pairs | _ { let (buf,_fin,m,args) = sargs - addUnicodeString buf (lexeme lexbuf); + addUnicodeString buf (lexeme lexbuf) if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } // Parsing single-line comment - we need to split it into words for Visual Studio IDE and singleLineComment cargs skip = parse | newline { let buff,_n,_m,args = cargs - trySaveXmlDoc lexbuf buff; - newline lexbuf; + trySaveXmlDoc lexbuf buff + newline lexbuf // Saves the documentation (if we're collecting any) into a buffer-local variable. if not skip then (LINE_COMMENT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } @@ -924,7 +924,7 @@ and singleLineComment cargs skip = parse | anywhite+ { let buff,n,m,args = cargs // Append the current token to the XML documentation if we're collecting it - tryAppendXmlDoc buff (lexeme lexbuf); + tryAppendXmlDoc buff (lexeme lexbuf) if not skip then (LINE_COMMENT (LexCont.SingleLineComment(!args.ifdefStack,n,m))) else singleLineComment (buff,n,m,args) skip lexbuf } | surrogateChar surrogateChar @@ -959,7 +959,7 @@ and comment cargs skip = parse | newline { let n,m,args = cargs - newline lexbuf; + newline lexbuf if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n,m))) else comment cargs skip lexbuf } | "*)" { @@ -983,7 +983,7 @@ and comment cargs skip = parse and stringInComment n m args skip = parse // Follow string lexing, skipping tokens until it finishes | '\\' newline anywhite* - { newline lexbuf; + { newline lexbuf if not skip then (COMMENT (LexCont.StringInComment(!args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } | escape_char @@ -1002,7 +1002,7 @@ and stringInComment n m args skip = parse { if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } | newline - { newline lexbuf; + { newline lexbuf if not skip then (COMMENT (LexCont.StringInComment(!args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } | eof @@ -1027,7 +1027,7 @@ and verbatimStringInComment n m args skip = parse { if not skip then (COMMENT (LexCont.VerbatimStringInComment(!args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } | newline - { newline lexbuf; + { newline lexbuf if not skip then (COMMENT (LexCont.VerbatimStringInComment(!args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } | eof @@ -1049,7 +1049,7 @@ and tripleQuoteStringInComment n m args skip = parse { if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(!args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf } | newline - { newline lexbuf; + { newline lexbuf if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(!args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf } | eof diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs index 0e92adadfee..f441549997d 100644 --- a/src/fsharp/lexhelp.fs +++ b/src/fsharp/lexhelp.fs @@ -3,7 +3,6 @@ module internal Microsoft.FSharp.Compiler.Lexhelp open System -open System.IO open System.Text open Internal.Utilities open Internal.Utilities.Collections @@ -52,10 +51,10 @@ type LexResourceManager() = /// Lexer parameters type lexargs = - { defines: string list; - ifdefStack: LexerIfdefStack; - resourceManager: LexResourceManager; - lightSyntaxStatus : LightSyntaxStatus; + { defines: string list + ifdefStack: LexerIfdefStack + resourceManager: LexResourceManager + lightSyntaxStatus : LightSyntaxStatus errorLogger: ErrorLogger } /// possible results of lexing a long unicode escape sequence in a string literal, e.g. "\UDEADBEEF" @@ -65,16 +64,16 @@ type LongUnicodeLexResult = | Invalid let mkLexargs (_filename,defines,lightSyntaxStatus,resourceManager,ifdefStack,errorLogger) = - { defines = defines; - ifdefStack= ifdefStack; - lightSyntaxStatus=lightSyntaxStatus; - resourceManager=resourceManager; + { defines = defines + ifdefStack= ifdefStack + lightSyntaxStatus=lightSyntaxStatus + resourceManager=resourceManager errorLogger=errorLogger } /// Register the lexbuf and call the given function let reusingLexbufForParsing lexbuf f = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) - LexbufLocalXmlDocStore.ClearXmlDoc lexbuf; + LexbufLocalXmlDocStore.ClearXmlDoc lexbuf try f () with e -> @@ -85,7 +84,7 @@ let resetLexbufPos filename (lexbuf: UnicodeLexing.Lexbuf) = /// Reset the lexbuf, configure the initial position with the given filename and call the given function let usingLexbufForParsing (lexbuf:UnicodeLexing.Lexbuf,filename) f = - resetLexbufPos filename lexbuf; + resetLexbufPos filename lexbuf reusingLexbufForParsing lexbuf (fun () -> f lexbuf) //------------------------------------------------------------------------ @@ -99,14 +98,14 @@ let callStringFinisher fin (buf: ByteBuffer) endm b = fin endm b (buf.Close()) let addUnicodeString (buf: ByteBuffer) (x:string) = buf.EmitBytes (Encoding.Unicode.GetBytes x) let addIntChar (buf: ByteBuffer) c = - buf.EmitIntAsByte (c % 256); + buf.EmitIntAsByte (c % 256) buf.EmitIntAsByte (c / 256) let addUnicodeChar buf c = addIntChar buf (int c) let addByteChar buf (c:char) = addIntChar buf (int32 c % 256) let stringBufferAsString (buf: byte[]) = - if buf.Length % 2 <> 0 then failwith "Expected even number of bytes"; + if buf.Length % 2 <> 0 then failwith "Expected even number of bytes" let chars : char[] = Array.zeroCreate (buf.Length/2) for i = 0 to (buf.Length/2) - 1 do let hi = buf.[i*2+1] @@ -150,15 +149,15 @@ let hexdigit d = else failwith "hexdigit" let unicodeGraphShort (s:string) = - if s.Length <> 4 then failwith "unicodegraph"; + if s.Length <> 4 then failwith "unicodegraph" uint16 (hexdigit s.[0] * 4096 + hexdigit s.[1] * 256 + hexdigit s.[2] * 16 + hexdigit s.[3]) let hexGraphShort (s:string) = - if s.Length <> 2 then failwith "hexgraph"; + if s.Length <> 2 then failwith "hexgraph" uint16 (hexdigit s.[0] * 16 + hexdigit s.[1]) let unicodeGraphLong (s:string) = - if s.Length <> 8 then failwith "unicodeGraphLong"; + if s.Length <> 8 then failwith "unicodeGraphLong" let high = hexdigit s.[0] * 4096 + hexdigit s.[1] * 256 + hexdigit s.[2] * 16 + hexdigit s.[3] in let low = hexdigit s.[4] * 4096 + hexdigit s.[5] * 256 + hexdigit s.[6] * 16 + hexdigit s.[7] in // not a surrogate pair @@ -198,103 +197,96 @@ module Keywords = | FSHARP (* keyword, but an identifier under --ml-compatibility mode *) let private keywordList = - [ FSHARP, "abstract", ABSTRACT; - ALWAYS, "and" ,AND; - ALWAYS, "as" ,AS; - ALWAYS, "assert" ,ASSERT; - ALWAYS, "asr" ,INFIX_STAR_STAR_OP "asr"; - ALWAYS, "base" ,BASE; - ALWAYS, "begin" ,BEGIN; - ALWAYS, "class" ,CLASS; - FSHARP, "const" ,CONST; - FSHARP, "default" ,DEFAULT; - FSHARP, "delegate" ,DELEGATE; - ALWAYS, "do" ,DO; - ALWAYS, "done" ,DONE; - FSHARP, "downcast" ,DOWNCAST; - ALWAYS, "downto" ,DOWNTO; - FSHARP, "elif" ,ELIF; - ALWAYS, "else" ,ELSE; - ALWAYS, "end" ,END; - ALWAYS, "exception" ,EXCEPTION; - FSHARP, "extern" ,EXTERN; - ALWAYS, "false" ,FALSE; - ALWAYS, "finally" ,FINALLY; - ALWAYS, "for" ,FOR; - ALWAYS, "fun" ,FUN; - ALWAYS, "function" ,FUNCTION; - FSHARP, "global" ,GLOBAL; - ALWAYS, "if" ,IF; - ALWAYS, "in" ,IN; - ALWAYS, "inherit" ,INHERIT; - FSHARP, "inline" ,INLINE; - FSHARP, "interface" ,INTERFACE; - FSHARP, "internal" ,INTERNAL; - ALWAYS, "land" ,INFIX_STAR_DIV_MOD_OP "land"; - ALWAYS, "lazy" ,LAZY; - ALWAYS, "let" ,LET(false); - ALWAYS, "lor" ,INFIX_STAR_DIV_MOD_OP "lor"; - ALWAYS, "lsl" ,INFIX_STAR_STAR_OP "lsl"; - ALWAYS, "lsr" ,INFIX_STAR_STAR_OP "lsr"; - ALWAYS, "lxor" ,INFIX_STAR_DIV_MOD_OP "lxor"; - ALWAYS, "match" ,MATCH; - FSHARP, "member" ,MEMBER; - ALWAYS, "mod" ,INFIX_STAR_DIV_MOD_OP "mod"; - ALWAYS, "module" ,MODULE; - ALWAYS, "mutable" ,MUTABLE; - FSHARP, "namespace" ,NAMESPACE; - ALWAYS, "new" ,NEW; - FSHARP, "null" ,NULL; - ALWAYS, "of" ,OF; - ALWAYS, "open" ,OPEN; - ALWAYS, "or" ,OR; - FSHARP, "override" ,OVERRIDE; - ALWAYS, "private" ,PRIVATE; - FSHARP, "public" ,PUBLIC; - ALWAYS, "rec" ,REC; - FSHARP, "return" ,YIELD(false); - ALWAYS, "sig" ,SIG; - FSHARP, "static" ,STATIC; - ALWAYS, "struct" ,STRUCT; - ALWAYS, "then" ,THEN; - ALWAYS, "to" ,TO; - ALWAYS, "true" ,TRUE; - ALWAYS, "try" ,TRY; - ALWAYS, "type" ,TYPE; - FSHARP, "upcast" ,UPCAST; - FSHARP, "use" ,LET(true); - ALWAYS, "val" ,VAL; - FSHARP, "void" ,VOID; - ALWAYS, "when" ,WHEN; - ALWAYS, "while" ,WHILE; - ALWAYS, "with" ,WITH; - FSHARP, "yield" ,YIELD(true); - ALWAYS, "_" ,UNDERSCORE; - (*------- for prototyping and explaining offside rule *) - FSHARP, "__token_OBLOCKSEP" ,OBLOCKSEP; - FSHARP, "__token_OWITH" ,OWITH; - FSHARP, "__token_ODECLEND" ,ODECLEND; - FSHARP, "__token_OTHEN" ,OTHEN; - FSHARP, "__token_OELSE" ,OELSE; - FSHARP, "__token_OEND" ,OEND; - FSHARP, "__token_ODO" ,ODO; - FSHARP, "__token_OLET" ,OLET(true); - FSHARP, "__token_constraint",CONSTRAINT; + [ FSHARP, "abstract", ABSTRACT + ALWAYS, "and" ,AND + ALWAYS, "as" ,AS + ALWAYS, "assert" ,ASSERT + ALWAYS, "asr" ,INFIX_STAR_STAR_OP "asr" + ALWAYS, "base" ,BASE + ALWAYS, "begin" ,BEGIN + ALWAYS, "class" ,CLASS + FSHARP, "const" ,CONST + FSHARP, "default" ,DEFAULT + FSHARP, "delegate" ,DELEGATE + ALWAYS, "do" ,DO + ALWAYS, "done" ,DONE + FSHARP, "downcast" ,DOWNCAST + ALWAYS, "downto" ,DOWNTO + FSHARP, "elif" ,ELIF + ALWAYS, "else" ,ELSE + ALWAYS, "end" ,END + ALWAYS, "exception" ,EXCEPTION + FSHARP, "extern" ,EXTERN + ALWAYS, "false" ,FALSE + ALWAYS, "finally" ,FINALLY + FSHARP, "fixed" ,FIXED + ALWAYS, "for" ,FOR + ALWAYS, "fun" ,FUN + ALWAYS, "function" ,FUNCTION + FSHARP, "global" ,GLOBAL + ALWAYS, "if" ,IF + ALWAYS, "in" ,IN + ALWAYS, "inherit" ,INHERIT + FSHARP, "inline" ,INLINE + FSHARP, "interface" ,INTERFACE + FSHARP, "internal" ,INTERNAL + ALWAYS, "land" ,INFIX_STAR_DIV_MOD_OP "land" + ALWAYS, "lazy" ,LAZY + ALWAYS, "let" ,LET(false) + ALWAYS, "lor" ,INFIX_STAR_DIV_MOD_OP "lor" + ALWAYS, "lsl" ,INFIX_STAR_STAR_OP "lsl" + ALWAYS, "lsr" ,INFIX_STAR_STAR_OP "lsr" + ALWAYS, "lxor" ,INFIX_STAR_DIV_MOD_OP "lxor" + ALWAYS, "match" ,MATCH + FSHARP, "member" ,MEMBER + ALWAYS, "mod" ,INFIX_STAR_DIV_MOD_OP "mod" + ALWAYS, "module" ,MODULE + ALWAYS, "mutable" ,MUTABLE + FSHARP, "namespace" ,NAMESPACE + ALWAYS, "new" ,NEW + FSHARP, "null" ,NULL + ALWAYS, "of" ,OF + ALWAYS, "open" ,OPEN + ALWAYS, "or" ,OR + FSHARP, "override" ,OVERRIDE + ALWAYS, "private" ,PRIVATE + FSHARP, "public" ,PUBLIC + ALWAYS, "rec" ,REC + FSHARP, "return" ,YIELD(false) + ALWAYS, "sig" ,SIG + FSHARP, "static" ,STATIC + ALWAYS, "struct" ,STRUCT + ALWAYS, "then" ,THEN + ALWAYS, "to" ,TO + ALWAYS, "true" ,TRUE + ALWAYS, "try" ,TRY + ALWAYS, "type" ,TYPE + FSHARP, "upcast" ,UPCAST + FSHARP, "use" ,LET(true) + ALWAYS, "val" ,VAL + FSHARP, "void" ,VOID + ALWAYS, "when" ,WHEN + ALWAYS, "while" ,WHILE + ALWAYS, "with" ,WITH + FSHARP, "yield" ,YIELD(true) + ALWAYS, "_" ,UNDERSCORE + (*------- for prototyping and explaining offside rule *) + FSHARP, "__token_OBLOCKSEP" ,OBLOCKSEP + FSHARP, "__token_OWITH" ,OWITH + FSHARP, "__token_ODECLEND" ,ODECLEND + FSHARP, "__token_OTHEN" ,OTHEN + FSHARP, "__token_OELSE" ,OELSE + FSHARP, "__token_OEND" ,OEND + FSHARP, "__token_ODO" ,ODO + FSHARP, "__token_OLET" ,OLET(true) + FSHARP, "__token_constraint",CONSTRAINT ] (*------- reserved keywords which are ml-compatibility ids *) @ List.map (fun s -> (FSHARP,s,RESERVED)) - [ "atomic"; "break"; - "checked"; "component"; "constraint"; "constructor"; "continue"; - "eager"; - "fixed"; "fori"; "functor"; - "include"; - "measure"; "method"; "mixin"; - "object"; + [ "break"; "checked"; "component"; "constraint"; "continue"; + "fori"; "include"; "mixin"; "parallel"; "params"; "process"; "protected"; "pure"; - "recursive"; - "sealed"; - "trait"; "tailcall"; - "virtual"; "volatile"; ] + "sealed"; "trait"; "tailcall"; "virtual"; ] let private unreserveWords = keywordList |> List.choose (function (mode,keyword,_) -> if mode = FSHARP then Some keyword else None) @@ -316,7 +308,7 @@ module Keywords = let IdentifierToken args (lexbuf:UnicodeLexing.Lexbuf) (s:string) = if IsCompilerGeneratedName s then - warning(Error(FSComp.SR.lexhlpIdentifiersContainingAtSymbolReserved(), lexbuf.LexemeRange)); + warning(Error(FSComp.SR.lexhlpIdentifiersContainingAtSymbolReserved(), lexbuf.LexemeRange)) args.resourceManager.InternIdentifierToken s let KeywordOrIdentifierToken args (lexbuf:UnicodeLexing.Lexbuf) s = @@ -324,25 +316,25 @@ module Keywords = | true,v -> match v with | RESERVED -> - warning(ReservedKeyword(FSComp.SR.lexhlpIdentifierReserved(s), lexbuf.LexemeRange)); + warning(ReservedKeyword(FSComp.SR.lexhlpIdentifierReserved(s), lexbuf.LexemeRange)) IdentifierToken args lexbuf s | _ -> v | _ -> match s with | "__SOURCE_DIRECTORY__" -> let filename = fileOfFileIndex lexbuf.StartPos.FileIndex - let dirname = + let dirname = if String.IsNullOrWhiteSpace(filename) then String.Empty else if filename = stdinMockFilename then - Directory.GetCurrentDirectory() + System.IO.Directory.GetCurrentDirectory() else - filename + filename |> FileSystem.GetFullPathShim (* asserts that path is already absolute *) - |> Path.GetDirectoryName + |> System.IO.Path.GetDirectoryName KEYWORD_STRING dirname | "__SOURCE_FILE__" -> - KEYWORD_STRING (Path.GetFileName((fileOfFileIndex lexbuf.StartPos.FileIndex))) + KEYWORD_STRING (System.IO.Path.GetFileName((fileOfFileIndex lexbuf.StartPos.FileIndex))) | "__LINE__" -> KEYWORD_STRING (string lexbuf.StartPos.Line) | _ -> diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 3ed305323e0..1a1e64acd23 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -308,18 +308,18 @@ let equalOn f x y = (f x) = (f y) let bufs f = let buf = System.Text.StringBuilder 100 - f buf; + f buf buf.ToString() let buff (os: TextWriter) f x = let buf = System.Text.StringBuilder 100 - f buf x; + f buf x os.Write(buf.ToString()) // Converts "\n" into System.Environment.NewLine before writing to os. See lib.fs:buff let writeViaBufferWithEnvironmentNewLines (os: TextWriter) f x = let buf = System.Text.StringBuilder 100 - f buf x; + f buf x let text = buf.ToString() let text = text.Replace("\n",System.Environment.NewLine) os.Write text @@ -373,14 +373,14 @@ let nullableSlotFull x = x // Caches, mainly for free variables //--------------------------------------------------------------------------- -type cache<'T> = { mutable cacheVal: 'T NonNullSlot; } +type cache<'T> = { mutable cacheVal: 'T NonNullSlot } let newCache() = { cacheVal = nullableSlotEmpty() } let inline cached cache resf = match box cache.cacheVal with | null -> let res = resf() - cache.cacheVal <- nullableSlotFull res; + cache.cacheVal <- nullableSlotFull res res | _ -> cache.cacheVal @@ -390,7 +390,7 @@ let inline cacheOptRef cache f = | Some v -> v | None -> let res = f() - cache := Some res; + cache := Some res res @@ -417,11 +417,11 @@ let delayInsertedToWorkaroundKnownNgenBug s f = (* Some random code to prevent inlining of this function *) let res = ref 10 for i = 0 to 2 do - res := !res + String.length s; - done; - if verbose then printf "------------------------executing NGEN bug delay '%s', calling 'f' --------------\n" s; + res := !res + String.length s + done + if verbose then printf "------------------------executing NGEN bug delay '%s', calling 'f' --------------\n" s let res = f() - if verbose then printf "------------------------exiting NGEN bug delay '%s' --------------\n" s; + if verbose then printf "------------------------exiting NGEN bug delay '%s' --------------\n" s res @@ -473,7 +473,7 @@ module internal AsyncUtil = if result.IsSome then [] else - result <- Some res; + result <- Some res // Invoke continuations in FIFO order // Continuations that Async.FromContinuations provide do QUWI/SynchContext.Post, // so the order is not overly relevant but still. diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 4095b35841e..37f87a0dc55 100755 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -112,16 +112,16 @@ let mkClassMemberLocalBindings(isStatic,initialRangeOpt,attrs,vis,BindingSetPreA | None -> bindingSetRange | Some m -> unionRanges m bindingSetRange if nonNil ignoredFreeAttrs then warning(Error(FSComp.SR.parsAttributesIgnored(),wholeRange)); - if isUse then errorR(Error(FSComp.SR.parsUseBindingsIllegalInImplicitClassConstructors(),wholeRange)); + if isUse then errorR(Error(FSComp.SR.parsUseBindingsIllegalInImplicitClassConstructors(),wholeRange)) SynMemberDefn.LetBindings (decls,isStatic,isRec,wholeRange) let mkLocalBindings (mWhole,BindingSetPreAttrs(_,isRec,isUse,declsPreAttrs,_),body) = let ignoredFreeAttrs,decls = declsPreAttrs [] None - if nonNil ignoredFreeAttrs then warning(Error(FSComp.SR.parsAttributesIgnored(),mWhole)); + if nonNil ignoredFreeAttrs then warning(Error(FSComp.SR.parsAttributesIgnored(),mWhole)) SynExpr.LetOrUse (isRec,isUse,decls,body,mWhole) let mkDefnBindings (mWhole,BindingSetPreAttrs(_,isRec,isUse,declsPreAttrs,_bindingSetRange),attrs,vis,attrsm) = - if isUse then warning(Error(FSComp.SR.parsUseBindingsIllegalInModules(),mWhole)); + if isUse then warning(Error(FSComp.SR.parsUseBindingsIllegalInModules(),mWhole)) let freeAttrs,decls = declsPreAttrs attrs vis let letDecls = [ SynModuleDecl.Let (isRec,decls,mWhole) ] let attrDecls = if nonNil freeAttrs then [ SynModuleDecl.Attributes (freeAttrs,attrsm) ] else [] @@ -134,7 +134,7 @@ let idOfPat m p = | _ -> raiseParseErrorAt m (FSComp.SR.parsIntegerForLoopRequiresSimpleIdentifier()) let checkForMultipleAugmentations m a1 a2 = - if nonNil a1 && nonNil a2 then raiseParseErrorAt m (FSComp.SR.parsOnlyOneWithAugmentationAllowed()); + if nonNil a1 && nonNil a2 then raiseParseErrorAt m (FSComp.SR.parsOnlyOneWithAugmentationAllowed()) a1 @ a2 let grabXmlDoc(parseState:IParseState,elemIdx) = @@ -252,6 +252,7 @@ let rangeOfLongIdent(lid:LongIdent) = %token OBLOCKEND OBLOCKEND_COMING_SOON OBLOCKEND_IS_HERE /* LexFilter #light inserts when closing CtxtSeqBlock(_,_,AddBlockEnd) */ %token OINTERFACE_MEMBER /* inserted for non-paranthetical use of 'INTERFACE', i.e. not INTERFACE/END */ +%token FIXED %token ODUMMY /* These are artificial */ @@ -490,7 +491,7 @@ interaction: { IDefns ($1,lhs parseState) } | SEMICOLON - { warning(Error(FSComp.SR.parsUnexpectedSemicolon(),rhs parseState 1)); + { warning(Error(FSComp.SR.parsUnexpectedSemicolon(),rhs parseState 1)) IDefns ([],lhs parseState) } | OBLOCKSEP @@ -546,7 +547,7 @@ interactiveDefns: /* An expression as part of one interaction in F# Interactive */ interactiveExpr: | opt_attributes opt_declVisibility declExpr - { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)); + { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) let attrDecls = if nonNil $1 then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] in attrDecls @ [ mkSynDoDecl($3)] } @@ -643,7 +644,7 @@ fileNamespaceSpecs: decls |> List.collect (function | (SynModuleSigDecl.HashDirective (hd,_)) -> [hd] | d -> - reportParseErrorAt d.Range (FSComp.SR.parsOnlyHashDirectivesAllowed()); + reportParseErrorAt d.Range (FSComp.SR.parsOnlyHashDirectivesAllowed()) []) ParsedSigFile(decls, $2) } @@ -663,12 +664,12 @@ fileNamespaceSpec: /* The single module declaration that can make up a signature file */ fileModuleSpec: | opt_attributes opt_declVisibility moduleIntro moduleSpfnsPossiblyEmptyBlock - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let m2 = rhs parseState 3 let m = (rhs2 parseState 3 4) let isRec,path2,xml,vis = $3 (fun (isRec2,path,_) -> - if nonNil path then errorR(Error(FSComp.SR.parsNamespaceOrModuleNotBoth(),m2)); + if nonNil path then errorR(Error(FSComp.SR.parsNamespaceOrModuleNotBoth(),m2)) let lid = path@path2 ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid, (isRec || isRec2), true, $4, xml,$1,vis,m))) } @@ -689,7 +690,7 @@ moduleSpfnsPossiblyEmptyBlock: | OBLOCKBEGIN moduleSpfnsPossiblyEmpty recover { // The lex filter ensures we can only get a mismatch in OBLOCKBEGIN/OBLOCKEND tokens if there was some other kind of error, hence we don't need to report this error - // reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnClosedBlockInHashLight()); + // reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnClosedBlockInHashLight()) $2 } @@ -727,24 +728,24 @@ moduleSpfn: { $1 } | opt_attributes opt_declVisibility moduleIntro colonOrEquals namedModuleAbbrevBlock - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let isRec, path, xml, vis = $3 - if isRec then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsInvalidUseOfRec()); - if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName()); - if List.length $1 <> 0 then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviation()); - if isSome(vis) then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreVisibilityOnModuleAbbreviationAlwaysPrivate()); + if isRec then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsInvalidUseOfRec()) + if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName()) + if List.length $1 <> 0 then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviation()) + if isSome(vis) then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreVisibilityOnModuleAbbreviationAlwaysPrivate()) SynModuleSigDecl.ModuleAbbrev(List.head path,$5,rhs2 parseState 3 5) } | opt_attributes opt_declVisibility moduleIntro colonOrEquals moduleSpecBlock { let isRec, path, xml, vis = $3 - if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleDefnMustBeSimpleName()); - if isRec then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsInvalidUseOfRec()); + if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleDefnMustBeSimpleName()) + if isRec then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsInvalidUseOfRec()) let info = ComponentInfo($1,[],[],path,xml,false,vis,rhs parseState 3) - if isSome($2) then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + if isSome($2) then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) SynModuleSigDecl.NestedModule(info, isRec, $5, rhs2 parseState 3 5) } | opt_attributes opt_declVisibility tyconSpfns - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let (TypeDefnSig(ComponentInfo(cas,a,cs,b,c,d,d2,d3),e,f,g)),rest = match $3 with | [] -> raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEmptyModuleDefn()) @@ -753,7 +754,7 @@ moduleSpfn: SynModuleSigDecl.Types (tc::rest,rhs parseState 3) } | opt_attributes opt_declVisibility exconSpfn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let (SynExceptionSig(SynExceptionDefnRepr(cas,a,b,c,d,d2),e,f)) = $3 let ec = (SynExceptionSig(SynExceptionDefnRepr($1@cas,a,b,c,d,d2),e,f)) SynModuleSigDecl.Exception(ec, rhs parseState 3) } @@ -763,9 +764,9 @@ moduleSpfn: valSpfn: | opt_attributes opt_declVisibility VAL opt_attributes opt_inline opt_mutable opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints optLiteralValueSpfn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let attr1,attr2,isInline,isMutable,vis2,id,doc,explicitValTyparDecls,(ty,arity),konst = ($1),($4),($5),($6),($7),($8),grabXmlDoc(parseState,3),($9),($11),($12) - if nonNil attr2 then errorR(Deprecated(FSComp.SR.parsAttributesMustComeBeforeVal(),rhs parseState 4)); + if nonNil attr2 then errorR(Deprecated(FSComp.SR.parsAttributesMustComeBeforeVal(),rhs parseState 4)) let m = rhs2 parseState 3 11 let valSpfn = ValSpfn((attr1@attr2),id,explicitValTyparDecls,ty,arity,isInline,isMutable,doc, vis2,konst,m) SynModuleSigDecl.Val(valSpfn,m) @@ -855,7 +856,7 @@ tyconSpfnRhs: let needsCheck,(kind,decls) = $1 (fun nameRange nameInfo augmentation -> if needsCheck && isNil decls then - reportParseErrorAt nameRange (FSComp.SR.parsEmptyTypeDefinition()); + reportParseErrorAt nameRange (FSComp.SR.parsEmptyTypeDefinition()) TypeDefnSig(nameInfo,SynTypeDefnSigRepr.ObjectModel (kind,decls,m),augmentation,m)) } | DELEGATE OF topType @@ -863,7 +864,7 @@ tyconSpfnRhs: let ty,arity = $3 let invoke = SynMemberSig.Member(ValSpfn([],mkSynId m "Invoke",inferredTyparDecls,ty,arity,false,false,PreXmlDoc.Empty,None,None,m),AbstractMemberFlags MemberKind.Member,m) (fun nameRange nameInfo augmentation -> - if nonNil augmentation then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()); + if nonNil augmentation then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) TypeDefnSig(nameInfo,SynTypeDefnSigRepr.ObjectModel (TyconDelegate (ty,arity),[invoke],m),[],m)) } @@ -877,7 +878,7 @@ tyconClassSpfn: { false,($1,$2) } | classOrInterfaceOrStruct classSpfnBlock recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedClassInterfaceOrStruct()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedClassInterfaceOrStruct()) false,($1,$2) } | classOrInterfaceOrStruct error END @@ -891,7 +892,7 @@ classSpfnBlockKindUnspecified: { true, $2 } | OBLOCKBEGIN classSpfnMembers recover - { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileTypeSignature()); + { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileTypeSignature()) false, $2 } /* NOTE: these rules enable the non-#light syntax to omit the kind of a type. */ @@ -908,7 +909,7 @@ classSpfnBlock: { $2 } | OBLOCKBEGIN classSpfnMembers recover - { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileTypeSignature()); + { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileTypeSignature()) $2 } | classSpfnMembers { $1 } @@ -931,7 +932,7 @@ classSpfnMembersAtLeastOne: /* A object member in a signature */ classMemberSpfn: | opt_attributes opt_declVisibility memberSpecFlags opt_inline opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints classMemberSpfnGetSet optLiteralValueSpfn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let isInline,doc,vis2,id,explicitValTyparDecls,(ty,arity),optLiteralValue = $4,grabXmlDoc(parseState,3),$5,$6,$7,$9,$11 let getSetRangeOpt, getSet = $10 let getSetAdjuster arity = match arity,getSet with SynValInfo([],_),MemberKind.Member -> MemberKind.PropertyGet | _ -> getSet @@ -945,24 +946,24 @@ classMemberSpfn: SynMemberSig.Member(valSpfn, flags (getSetAdjuster arity),wholeRange) } | opt_attributes opt_declVisibility interfaceMember appType - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) SynMemberSig.Interface ($4,unionRanges (rhs parseState 3) ($4).Range) } | opt_attributes opt_declVisibility INHERIT appType - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) SynMemberSig.Inherit ($4,unionRanges (rhs parseState 3) ($4).Range) } | opt_attributes opt_declVisibility VAL fieldDecl - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let fld = $4 $1 false SynMemberSig.ValField(fld,rhs2 parseState 3 4) } | opt_attributes opt_declVisibility STATIC VAL fieldDecl - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) SynMemberSig.ValField($5 $1 true,rhs2 parseState 3 5) } | opt_attributes opt_declVisibility STATIC typeKeyword tyconSpfn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) SynMemberSig.NestedType($5,rhs2 parseState 3 5) } | opt_attributes opt_declVisibility NEW COLON topTypeWithTypeConstraints @@ -985,7 +986,7 @@ classMemberSpfnGetSet: { Some (rhs2 parseState 1 2), $2 } | OWITH classMemberSpfnGetSetElements error - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedWith()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedWith()) Some (rhs2 parseState 1 2), $2 } @@ -1001,7 +1002,7 @@ classMemberSpfnGetSetElements: { let (id:Ident) = $1 if not ((id.idText = "get" && $3.idText = "set") || (id.idText = "set" && $3.idText = "get")) then - raiseParseErrorAt (rhs2 parseState 1 3) (FSComp.SR.parsGetOrSetRequired()); + raiseParseErrorAt (rhs2 parseState 1 3) (FSComp.SR.parsGetOrSetRequired()) MemberKind.PropertyGetSet } memberSpecFlags: @@ -1061,7 +1062,7 @@ fileNamespaceImpls: decls |> List.collect (function | (SynModuleDecl.HashDirective (hd,_)) -> [hd] | d -> - reportParseErrorAt d.Range (FSComp.SR.parsOnlyHashDirectivesAllowed()); + reportParseErrorAt d.Range (FSComp.SR.parsOnlyHashDirectivesAllowed()) []) ParsedImplFile(decls, $2) } @@ -1084,12 +1085,12 @@ fileNamespaceImpl: /* A single module definition in an implementation file */ fileModuleImpl: | opt_attributes opt_declVisibility moduleIntro moduleDefnsOrExprPossiblyEmptyOrBlock - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let m2 = rhs parseState 3 let m = (m2, $4) ||> unionRangeWithListBy (fun modu -> modu.Range) let isRec2,path2,xml,vis = $3 (fun (isRec, path, _) -> - if nonNil path then errorR(Error(FSComp.SR.parsNamespaceOrModuleNotBoth(),m2)); + if nonNil path then errorR(Error(FSComp.SR.parsNamespaceOrModuleNotBoth(),m2)) let lid = path@path2 ParsedImplFileFragment.NamedModule(SynModuleOrNamespace(lid, (isRec || isRec2), true, $4, xml,$1,vis,m))) } @@ -1108,7 +1109,7 @@ moduleDefnsOrExprPossiblyEmptyOrBlock: | OBLOCKBEGIN moduleDefnsOrExprPossiblyEmpty recover { // The lex filter ensures we can only get a mismatch in OBLOCKBEGIN/OBLOCKEND tokens if there was some other kind of error, hence we don't need to report this error - // reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnClosedBlockInHashLight()); + // reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnClosedBlockInHashLight()) $2 } | OBLOCKBEGIN error oblockend @@ -1131,17 +1132,17 @@ moduleDefnsOrExprPossiblyEmpty: /* A naked expression is only allowed at the start of a module/file, or straight after a topSeparators */ moduleDefnsOrExpr: | opt_attributes opt_declVisibility declExpr topSeparators moduleDefnsOrExpr - { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)); + { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) let attrDecls = if nonNil $1 then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] attrDecls @ mkSynDoDecl ($3) :: $5 } | opt_attributes opt_declVisibility declExpr topSeparators - { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)); + { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) let attrDecls = if nonNil $1 then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] attrDecls @ [ mkSynDoDecl($3) ] } | opt_attributes opt_declVisibility declExpr - { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)); + { if isSome $2 then errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(),rhs parseState 3)) let attrDecls = if nonNil $1 then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] attrDecls @ [ mkSynDoDecl($3) ] } @@ -1185,27 +1186,27 @@ moduleDefn: /* 'let' definitions in non-#light*/ | opt_attributes opt_declVisibility defnBindings %prec decl_let - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); - parseState.ResetSynArgNameGenerator(); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + parseState.ResetSynArgNameGenerator() let (BindingSetPreAttrs(_,_,_,_,mWhole)) = $3 mkDefnBindings (mWhole,$3,$1,$2,mWhole) } /* 'let' or 'do' definitions in #light */ | opt_attributes opt_declVisibility hardwhiteLetBindings %prec decl_let { let hwlb,m = $3 - if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); - parseState.ResetSynArgNameGenerator(); + if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + parseState.ResetSynArgNameGenerator() mkDefnBindings (m,hwlb,$1,$2,m) } /* 'do' definitions in non-#light*/ | opt_attributes opt_declVisibility doBinding %prec decl_let - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let mWhole = rhs parseState 3 mkDefnBindings (mWhole,$3,$1,$2,mWhole) } /* 'type' definitions */ | opt_attributes opt_declVisibility typeKeyword tyconDefn tyconDefnList - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let (TypeDefn(ComponentInfo(cas ,a,cs,b,c,d,d2,d3),e,f,g)) = $4 let tc = (TypeDefn(ComponentInfo($1@cas,a,cs,b,c,d,d2,d3),e,f,g)) let types = tc :: $5 @@ -1213,7 +1214,7 @@ moduleDefn: /* 'exception' definitions */ | opt_attributes opt_declVisibility exconDefn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let (SynExceptionDefn(SynExceptionDefnRepr(cas,a,b,c,d,d2),e,f)) = $3 let f = (f, $1) ||> unionRangeWithListBy (fun a -> a.Range) let ec = (SynExceptionDefn(SynExceptionDefnRepr($1@cas,a,b,c,d,d2),e,f)) @@ -1221,18 +1222,18 @@ moduleDefn: /* 'module' definitions */ | opt_attributes opt_declVisibility moduleIntro EQUALS namedModuleDefnBlock - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let attribs, (isRec, path, xml, vis) = $1,$3 match $5 with | Choice1Of2 eqn -> - if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); - if isRec then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsInvalidUseOfRec()); - if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName()); - if List.length $1 <> 0 then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviation()); - if isSome vis then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviationAlwaysPrivate()); + if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) + if isRec then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsInvalidUseOfRec()) + if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName()) + if List.length $1 <> 0 then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviation()) + if isSome vis then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviationAlwaysPrivate()) [ SynModuleDecl.ModuleAbbrev(List.head path,eqn,(rhs parseState 3, eqn) ||> unionRangeWithListBy (fun id -> id.idRange) ) ] | Choice2Of2 def -> - if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName()); + if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName()) let info = ComponentInfo(attribs,[],[],path,xml,false,vis,rhs parseState 3) [ SynModuleDecl.NestedModule(info, isRec, def, false,(rhs2 parseState 3 4, def) ||> unionRangeWithListBy (fun d -> d.Range) ) ] } @@ -1294,7 +1295,7 @@ namedModuleDefnBlock: | OBLOCKBEGIN moduleDefnsOrExpr recover { // The lex filter ensures we can only get a mismatch in OBLOCKBEGIN/OBLOCKEND tokens if there was some other kind of error, hence we don't need to report this error - // reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnClosedBlockInHashLight()); + // reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnClosedBlockInHashLight()) Choice2Of2 $2 } | OBLOCKBEGIN error oblockend @@ -1313,7 +1314,7 @@ wrappedNamedModuleDefn: { $2 } | structOrBegin moduleDefnsOrExprPossiblyEmpty recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBeginOrStruct()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBeginOrStruct()) $2 } | structOrBegin error END @@ -1351,11 +1352,11 @@ attributeList: { [] } | LBRACK_LESS attributeListElements opt_seps ends_coming_soon_or_recover - { if not $4 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedLBrackLess()); + { if not $4 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedLBrackLess()) $2 } | LBRACK_LESS ends_coming_soon_or_recover - { if not $2 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedLBrackLess()); + { if not $2 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedLBrackLess()) [] } @@ -1398,7 +1399,7 @@ attributeTarget: /* return */ | YIELD COLON - { if $1 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsSyntaxError()); + { if $1 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsSyntaxError()) Some(ident("return",(rhs parseState 1))) } /* Flags on a member */ @@ -1494,7 +1495,7 @@ tyconDefnRhs: | Some m -> m (fun nameRange augmentation -> if needsCheck && isNil decls then - reportParseErrorAt nameRange (FSComp.SR.parsEmptyTypeDefinition()); + reportParseErrorAt nameRange (FSComp.SR.parsEmptyTypeDefinition()) SynTypeDefnRepr.ObjectModel (kind,decls,m),augmentation) } /* A delegate type definition */ @@ -1504,7 +1505,7 @@ tyconDefnRhs: (fun nameRange augmentation -> let valSpfn = ValSpfn([],mkSynId m "Invoke",inferredTyparDecls,ty,arity,false,false,PreXmlDoc.Empty,None,None,m) let invoke = SynMemberDefn.AbstractSlot(valSpfn,AbstractMemberFlags MemberKind.Member,m) - if nonNil augmentation then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()); + if nonNil augmentation then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) SynTypeDefnRepr.ObjectModel (TyconDelegate (ty,arity),[invoke],m),[]) } @@ -1531,7 +1532,7 @@ tyconClassDefn: /* The right-hand-side of a object type definition where the class/interface/struct kind has not been specified */ classDefnBlockKindUnspecified: | OBLOCKBEGIN classDefnMembers recover - { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileTypeDefinition()); + { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileTypeDefinition()) let mopt = match $2 with | _::_ -> Some( (rhs parseState 1, $2) ||> unionRangeWithListBy (fun (d:SynMemberDefn) -> d.Range) ) @@ -1549,7 +1550,7 @@ classDefnBlockKindUnspecified: /* The contents of an object type definition or type augmentation */ classDefnBlock: | OBLOCKBEGIN classDefnMembers recover - { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileTypeDefinition()); + { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileTypeDefinition()) $2 } | OBLOCKBEGIN classDefnMembers oblockend @@ -1587,7 +1588,7 @@ classDefnMemberGetSet: { $2 } | OWITH classDefnMemberGetSetElements error - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedWith()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedWith()) $2 } /* The "get,set" part of a member definition */ @@ -1673,7 +1674,7 @@ memberCore: begin match optPropertyType with | Some _ -> errorR(Error(FSComp.SR.parsTypeAnnotationsOnGetSet(),mBindLhs)) | None -> () - end; + end let optReturnType = match (memberKind, optReturnType) with @@ -1753,7 +1754,7 @@ memberCore: | None,None -> None | Some lidVisInner,None | None,Some lidVisInner -> Some lidVisInner | Some _, Some _ -> - errorR(Error(FSComp.SR.parsMultipleAccessibilitiesForGetSet(),mBindLhs)); + errorR(Error(FSComp.SR.parsMultipleAccessibilitiesForGetSet(),mBindLhs)) lidVisInner // Replace the "get" or the "set" with the right name @@ -1797,21 +1798,21 @@ abstractMemberFlags: /* A member definition */ classDefnMember: | opt_attributes opt_declVisibility classDefnBindings - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) [mkClassMemberLocalBindings(false,None,$1,$2,$3)] } | opt_attributes opt_declVisibility STATIC classDefnBindings - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) [mkClassMemberLocalBindings(true,Some (rhs parseState 3),$1,$2,$4)] } | opt_attributes opt_declVisibility memberFlags memberCore opt_ODECLEND - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) let _,flags = $3 $4 $2 flags $1 } | opt_attributes opt_declVisibility interfaceMember appType opt_interfaceImplDefn - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesAreNotPermittedOnInterfaceImplementations(),rhs parseState 1)); - if isSome $2 then errorR(Error(FSComp.SR.parsInterfacesHaveSameVisibilityAsEnclosingType(),rhs parseState 3)); + { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesAreNotPermittedOnInterfaceImplementations(),rhs parseState 1)) + if isSome $2 then errorR(Error(FSComp.SR.parsInterfacesHaveSameVisibilityAsEnclosingType(),rhs parseState 3)) let mWhole = match $5 with | None -> rhs2 parseState 3 4 @@ -1828,21 +1829,21 @@ classDefnMember: match getSetRangeOpt with | None -> unionRanges m ty.Range | Some m2 -> unionRanges m m2 - if isSome $2 then errorR(Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract(),wholeRange)); + if isSome $2 then errorR(Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract(),wholeRange)) let valSpfn = ValSpfn($1,id,explicitValTyparDecls,ty,arity, isInline,false,doc, None,None,wholeRange) [ SynMemberDefn.AbstractSlot(valSpfn,AbstractMemberFlags (getSetAdjuster arity), wholeRange) ] } | opt_attributes opt_declVisibility inheritsDefn - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalOnInherit(),rhs parseState 1)); - if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityIllegalOnInherit(),rhs parseState 1)); + { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalOnInherit(),rhs parseState 1)) + if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityIllegalOnInherit(),rhs parseState 1)) [ $3 ] } | opt_attributes opt_declVisibility valDefnDecl opt_ODECLEND - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) $3 None $1 false } | opt_attributes opt_declVisibility STATIC valDefnDecl opt_ODECLEND - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) $4 (Some (rhs parseState 3)) $1 true } | opt_attributes opt_declVisibility memberFlags autoPropsDefnDecl opt_ODECLEND @@ -1857,11 +1858,11 @@ classDefnMember: let vis = $2 let declPat = SynPat.LongIdent (LongIdentWithDots([mkSynId (rhs parseState 3) "new"],[]),None,Some noInferredTypars, SynConstructorArgs.Pats [$4],vis,rhs parseState 3) // Check that 'SynPatForConstructorDecl' matches this correctly - assert (match declPat with SynPatForConstructorDecl _ -> true | _ -> false); + assert (match declPat with SynPatForConstructorDecl _ -> true | _ -> false) [ SynMemberDefn.Member(Binding (None,NormalBinding,false,false,$1,grabXmlDoc(parseState,3),valSynData, declPat,None,expr,m,NoSequencePointAtInvisibleBinding),m) ] } | opt_attributes opt_declVisibility STATIC typeKeyword tyconDefn - { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2)) [ SynMemberDefn.NestedType($5,None,rhs2 parseState 3 5) ] } @@ -1957,11 +1958,11 @@ optBaseSpec: baseSpec: | AS ident { if ($2).idText <> "base" then - errorR(Error(FSComp.SR.parsInheritDeclarationsCannotHaveAsBindings(),rhs2 parseState 1 2)); + errorR(Error(FSComp.SR.parsInheritDeclarationsCannotHaveAsBindings(),rhs2 parseState 1 2)) ident("base",rhs parseState 2) } | AS BASE - { errorR(Error(FSComp.SR.parsInheritDeclarationsCannotHaveAsBindings(),rhs2 parseState 1 2)); + { errorR(Error(FSComp.SR.parsInheritDeclarationsCannotHaveAsBindings(),rhs2 parseState 1 2)) ident("base",rhs parseState 2) } @@ -1971,7 +1972,7 @@ objectImplementationBlock: { $2 } | OBLOCKBEGIN objectImplementationMembers recover - { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileObjectMembers()); + { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileObjectMembers()) $2 } | objectImplementationMembers @@ -2017,13 +2018,13 @@ tyconDefnOrSpfnSimpleRepr: /* A type abbreviation */ | opt_attributes opt_declVisibility typ - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)); - if isSome $2 then errorR(Error(FSComp.SR.parsTypeAbbreviationsCannotHaveVisibilityDeclarations(),rhs parseState 2)); + { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) + if isSome $2 then errorR(Error(FSComp.SR.parsTypeAbbreviationsCannotHaveVisibilityDeclarations(),rhs parseState 2)) SynTypeDefnSimpleRepr.TypeAbbrev (ParserDetail.Ok, $3, unionRanges (rhs parseState 1) $3.Range) } /* A union type definition */ | opt_attributes opt_declVisibility unionTypeRepr - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)); + { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) let rangesOf3 = $3 |> List.map (function |Choice1Of2(ec)->ec.Range | Choice2Of2(uc)->uc.Range) let mWhole = (rhs2 parseState 1 2, rangesOf3) ||> List.fold unionRanges if $3 |> List.exists (function Choice1Of2 _ -> true | _ -> false) then ( @@ -2041,14 +2042,14 @@ tyconDefnOrSpfnSimpleRepr: /* A record type definition */ | opt_attributes opt_declVisibility braceFieldDeclList - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)); + { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) SynTypeDefnSimpleRepr.Record ($2,$3,lhs parseState) } /* An inline-assembly type definition, for FSharp.Core library only */ | opt_attributes opt_declVisibility LPAREN inlineAssemblyTyconRepr rparen - { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)); - libraryOnlyError (lhs parseState); - if isSome $2 then errorR(Error(FSComp.SR.parsInlineAssemblyCannotHaveVisibilityDeclarations(),rhs parseState 2)); + { if nonNil $1 then errorR(Error(FSComp.SR.parsAttributesIllegalHere(),rhs parseState 1)) + libraryOnlyError (lhs parseState) + if isSome $2 then errorR(Error(FSComp.SR.parsInlineAssemblyCannotHaveVisibilityDeclarations(),rhs parseState 2)) $4 } @@ -2058,7 +2059,7 @@ braceFieldDeclList: { $2 } | LBRACE recdFieldDeclList recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBrace()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBrace()) $2 } | LBRACE error rbrace @@ -2066,7 +2067,7 @@ braceFieldDeclList: inlineAssemblyTyconRepr: | HASH stringOrKeywordString HASH - { libraryOnlyError (lhs parseState); + { libraryOnlyError (lhs parseState) let lhsm = lhs parseState SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (ParseAssemblyCodeType $2 (rhs parseState 2),lhsm) } @@ -2106,7 +2107,7 @@ typarDecl : /* See the F# specification "Lexical analysis of type applications and type parameter definitions" */ postfixTyparDecls: | opt_HIGH_PRECEDENCE_TYAPP LESS typarDeclList opt_typeConstraints GREATER - { if not $2 then warning(Error(FSComp.SR.parsNonAdjacentTypars(),rhs2 parseState 2 5)); + { if not $2 then warning(Error(FSComp.SR.parsNonAdjacentTypars(),rhs2 parseState 2 5)) List.rev $3, $4 } /* Any tokens in this grammar must be added to the lex filter rule 'peekAdjacentTypars' */ @@ -2121,7 +2122,7 @@ explicitValTyparDeclsCore: explicitValTyparDecls: | opt_HIGH_PRECEDENCE_TYAPP LESS explicitValTyparDeclsCore opt_typeConstraints GREATER - { if not $2 then warning(Error(FSComp.SR.parsNonAdjacentTypars(),rhs2 parseState 2 5)); + { if not $2 then warning(Error(FSComp.SR.parsNonAdjacentTypars(),rhs2 parseState 2 5)) let tps,flex = $3 SynValTyparDecls(tps,flex,$4) } @@ -2164,7 +2165,7 @@ typeConstraint: { WhereTyparIsValueType($1,lhs parseState) } | typar COLON IDENT STRUCT - { if $3 <> "not" then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedIdentifier($3)); + { if $3 <> "not" then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedIdentifier($3)) WhereTyparIsReferenceType($1,lhs parseState) } | typar COLON NULL @@ -2218,26 +2219,26 @@ attrUnionCaseDecls: /* The core of a union case definition */ attrUnionCaseDecl: | opt_attributes opt_access unionCaseName opt_OBLOCKSEP - { if isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)) let mDecl = rhs parseState 3 (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3,UnionCaseFields [],xmlDoc,None,mDecl))) } | opt_attributes opt_access unionCaseName OF unionCaseRepr opt_OBLOCKSEP - { if isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)) let mDecl = rhs2 parseState 3 5 (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3,UnionCaseFields $5,xmlDoc,None,mDecl))) } | opt_attributes opt_access unionCaseName COLON topType opt_OBLOCKSEP - { if isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)); - libraryOnlyWarning(lhs parseState); + { if isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(),rhs parseState 2)) + libraryOnlyWarning(lhs parseState) let mDecl = rhs2 parseState 3 5 (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3,UnionCaseFullType $5,xmlDoc,None,mDecl))) } | opt_attributes opt_access unionCaseName EQUALS constant opt_OBLOCKSEP - { if isSome $2 then errorR(Error(FSComp.SR.parsEnumFieldsCannotHaveVisibilityDeclarations(),rhs parseState 2)); + { if isSome $2 then errorR(Error(FSComp.SR.parsEnumFieldsCannotHaveVisibilityDeclarations(),rhs parseState 2)) let mDecl = rhs2 parseState 3 5 (fun xmlDoc -> Choice1Of2 (EnumCase ( $1, $3,$5,xmlDoc,mDecl))) } @@ -2280,7 +2281,7 @@ unionCaseReprElement: unionCaseRepr: | braceFieldDeclList - { errorR(Deprecated(FSComp.SR.parsConsiderUsingSeparateRecordType(),lhs parseState)); + { errorR(Deprecated(FSComp.SR.parsConsiderUsingSeparateRecordType(),lhs parseState)) $1 } | unionCaseReprElements @@ -2299,7 +2300,7 @@ recdFieldDecl: | opt_attributes fieldDecl { let fld = $2 $1 false let (Field(a,b,c,d,e,f,vis,g)) = fld - if isSome vis then errorR(Error(FSComp.SR.parsRecordFieldsCannotHaveVisibilityDeclarations(),rhs parseState 2)); + if isSome vis then errorR(Error(FSComp.SR.parsRecordFieldsCannotHaveVisibilityDeclarations(),rhs parseState 2)) Field(a,b,c,d,e,f,None,g) } /* Part of a field or val declaration in a record type or object type */ @@ -2363,7 +2364,7 @@ defnBindings: // apply the builder let binds = localBindingsBuilder attrs vis mLetKwd if not isRec && List.length binds > 1 then - reportParseErrorAt mLetKwd (FSComp.SR.parsLetAndForNonRecBindings()); + reportParseErrorAt mLetKwd (FSComp.SR.parsLetAndForNonRecBindings()) [],binds), bindingSetRange) } @@ -2388,7 +2389,7 @@ hardwhiteLetBindings: { let mLetKwd = rhs parseState 1 let isUse = $1 let isRec = $2 - $4 (if isUse then "use" else "let") mLetKwd; // report unterminated error + $4 (if isUse then "use" else "let") mLetKwd // report unterminated error let localBindingsLastRangeOpt, localBindingsBuilder = $3 @@ -2403,7 +2404,7 @@ hardwhiteLetBindings: (fun attrs vis -> let binds = localBindingsBuilder attrs vis mLetKwd if not isRec && List.length binds > 1 then - reportParseErrorAt mLetKwd (FSComp.SR.parsLetAndForNonRecBindings()); + reportParseErrorAt mLetKwd (FSComp.SR.parsLetAndForNonRecBindings()) [],binds), bindingSetRange), (unionRanges mLetKwd bindingSetRange) } @@ -2607,7 +2608,7 @@ typedExprWithStaticOptimizationsBlock: { $2 } | OBLOCKBEGIN typedExprWithStaticOptimizations recover - { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFile()); + { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFile()) let a,b = $2 (exprFromParseError a, b) } @@ -2633,16 +2634,16 @@ staticOptimizationCondition: | typar STRUCT { WhenTyparIsStruct($1,lhs parseState) } rawConstant: - | INT8 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideEightBitSigned(), lhs parseState)); + | INT8 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideEightBitSigned(), lhs parseState)) SynConst.SByte (fst $1) } | UINT8 { SynConst.Byte $1 } - | INT16 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideSixteenBitSigned(), lhs parseState)); + | INT16 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideSixteenBitSigned(), lhs parseState)) SynConst.Int16 (fst $1) } | UINT16 { SynConst.UInt16 $1 } - | INT32 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)); + | INT32 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)) SynConst.Int32 (fst $1) } | UINT32 { SynConst.UInt32 $1 } - | INT64 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideSixtyFourBitSigned(), lhs parseState)); + | INT64 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideSixtyFourBitSigned(), lhs parseState)) SynConst.Int64 (fst $1) } | UINT64 { SynConst.UInt64 $1 } | NATIVEINT { SynConst.IntPtr $1 } @@ -2657,25 +2658,25 @@ rawConstant: rationalConstant: | INT32 INFIX_STAR_DIV_MOD_OP INT32 - { if $2 <> "/" then reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnexpectedOperatorForUnitOfMeasure()); - if fst $3 = 0 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsIllegalDenominatorForMeasureExponent()); - if (snd $1) || (snd $3) then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)); + { if $2 <> "/" then reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnexpectedOperatorForUnitOfMeasure()) + if fst $3 = 0 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsIllegalDenominatorForMeasureExponent()) + if (snd $1) || (snd $3) then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)) SynRationalConst.Rational(fst $1, fst $3, lhs parseState) } | MINUS INT32 INFIX_STAR_DIV_MOD_OP INT32 - { if $3 <> "/" then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedOperatorForUnitOfMeasure()); - if fst $4 = 0 then reportParseErrorAt (rhs parseState 4) (FSComp.SR.parsIllegalDenominatorForMeasureExponent()); - if (snd $2) || (snd $4) then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)); + { if $3 <> "/" then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedOperatorForUnitOfMeasure()) + if fst $4 = 0 then reportParseErrorAt (rhs parseState 4) (FSComp.SR.parsIllegalDenominatorForMeasureExponent()) + if (snd $2) || (snd $4) then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)) SynRationalConst.Negate(SynRationalConst.Rational(fst $2, fst $4, lhs parseState)) } - | INT32 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)); + | INT32 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)) SynRationalConst.Integer(fst $1) } - | MINUS INT32 { if snd $2 then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)); + | MINUS INT32 { if snd $2 then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)) SynRationalConst.Negate(SynRationalConst.Integer(fst $2)) } atomicUnsignedRationalConstant: - | INT32 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)); + | INT32 { if snd $1 then errorR(Error(FSComp.SR.lexOutsideThirtyTwoBitSigned(), lhs parseState)) SynRationalConst.Integer(fst $1) } | LPAREN rationalConstant rparen @@ -2721,12 +2722,12 @@ simplePatterns: | LPAREN rparen { [] } | LPAREN simplePatternCommaList recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()) [] } | LPAREN error rparen { (* silent recovery *) [] } | LPAREN recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()) [] } @@ -2785,10 +2786,10 @@ atomicPatterns: | atomicPattern atomicPatterns %prec pat_args { $1 :: $2 } | atomicPattern HIGH_PRECEDENCE_BRACK_APP atomicPatterns - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsSuccessivePatternsShouldBeSpacedOrTupled()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsSuccessivePatternsShouldBeSpacedOrTupled()) $1 :: $3 } | atomicPattern HIGH_PRECEDENCE_PAREN_APP atomicPatterns - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsSuccessivePatternsShouldBeSpacedOrTupled()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsSuccessivePatternsShouldBeSpacedOrTupled()) $1 :: $3 } | atomicPattern { [$1] } @@ -2824,12 +2825,12 @@ atomicPattern: { let m = (lhs parseState) SynPat.Paren($2 m,m) } | LPAREN parenPatternBody recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()) patFromParseError ($2 (rhs2 parseState 1 2)) } | LPAREN error rparen { (* silent recovery *) SynPat.Wild (lhs parseState) } | LPAREN recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()) SynPat.Wild (lhs parseState)} @@ -2921,7 +2922,7 @@ typedSeqExprBlock: | OBLOCKBEGIN typedSeqExpr oblockend { $2 } | OBLOCKBEGIN typedSeqExpr recover - { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileExpression()); + { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileExpression()) exprFromParseError $2 } | typedSeqExpr { $1 } @@ -3019,7 +3020,7 @@ declExpr: SynExpr.Match(spBind, $2,clauses,false,unionRanges mMatch mLast) } | MATCH typedSeqExpr recover %prec expr_match - { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileMatch()); + { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileMatch()) // Produce approximate expression during error recovery exprFromParseError $2 } @@ -3036,7 +3037,7 @@ declExpr: | TRY typedSeqExprBlockR recover %prec expr_try { // Produce approximate expression during error recovery // Include any expressions to make sure they gets type checked in case that generates useful results for intellisense - if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileTry()); + if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileTry()) exprFromParseError $2 } | TRY typedSeqExprBlockR FINALLY typedSeqExprBlock %prec expr_try @@ -3051,7 +3052,7 @@ declExpr: $3 $2 mIf } | IF declExpr recover %prec expr_if - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsIncompleteIf()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsIncompleteIf()) // Produce an approximate expression during error recovery. // Include expressions to make sure they get type checked in case that generates useful results for intellisense. // Generate a throwAway for the expression so it isn't forced to have a type 'bool' @@ -3092,7 +3093,7 @@ declExpr: SynExpr.While(spWhile,$2,$4,mWhileAll) } | WHILE declExpr doToken typedSeqExprBlock recover - { if not $5 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileWhile()); + { if not $5 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileWhile()) let mWhileHeader = unionRanges (rhs parseState 1) $2.Range let spWhile = SequencePointAtWhileLoop mWhileHeader let mWhileAll = unionRanges (rhs parseState 1) $4.Range @@ -3115,7 +3116,7 @@ declExpr: exprFromParseError (SynExpr.While(spWhile,$2,arbExpr("whileBody2",mWhileBodyArb),mWhileAll)) } | WHILE recover - { if not $2 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileWhile()); + { if not $2 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileWhile()) arbExpr("whileLoop1",rhs parseState 1) } | WHILE error doneDeclEnd @@ -3173,7 +3174,7 @@ declExpr: SynExpr.For(spBind,a,b,c,d,$4,mForLoopAll) } | FOR forLoopRange doToken typedSeqExprBlock recover - { if not $5 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()); + { if not $5 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()) // Still produce an expression let mForLoopHeader = rhs2 parseState 1 3 let spBind = SequencePointAtForLoop mForLoopHeader @@ -3200,7 +3201,7 @@ declExpr: exprFromParseError (SynExpr.For(spBind,a,b,c,d,arbExpr("declExpr11",mForLoopBodyArb),mForLoopAll)) } | FOR forLoopRange recover - { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()); + { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()) let mForLoopHeader = rhs2 parseState 1 2 let spBind = SequencePointAtForLoop mForLoopHeader let (a,b,c,d) = $2 @@ -3241,7 +3242,7 @@ declExpr: SynExpr.ForEach(spBind,SeqExprOnly false,true,$2,arbExpr("forLoopCollection",mForLoopHeader),arbExpr("forLoopBody3",mForLoopBodyArb),mForLoopAll) } | FOR parenPattern recover - { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()); + { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileFor()) let mForLoopHeader = rhs2 parseState 1 2 let spBind = SequencePointAtForLoop mForLoopHeader let mForLoopBodyArb = (rhs parseState 2).EndRange @@ -3261,7 +3262,7 @@ declExpr: SynExpr.LetOrUseBang(spBind,($1 = "use"),true,$2,$4,$7,m) } | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP typedSeqExprBlock %prec expr_let - { $5 (if $1 = "use" then "use!" else "let!") (rhs parseState 1); // report unterminated error + { $5 (if $1 = "use" then "use!" else "let!") (rhs parseState 1) // report unterminated error let spBind = SequencePointAtBinding(unionRanges (rhs parseState 1) $4.Range) let m = unionRanges (rhs parseState 1) $7.Range SynExpr.LetOrUseBang(spBind,($1 = "use"),true,$2,$4,$7,m) } @@ -3284,8 +3285,11 @@ declExpr: { let spBind = SequencePointAtForLoop(rhs2 parseState 1 2) let (a,b,_) = $2 in SynExpr.ForEach(spBind,SeqExprOnly true,true,a,b,$4,unionRanges (rhs parseState 1) $4.Range) } + | FIXED declExpr + { SynExpr.Fixed($2, (unionRanges (rhs parseState 1) $2.Range)) } + | RARROW typedSeqExprBlockR - { errorR(Error(FSComp.SR.parsArrowUseIsLimited(),lhs parseState)); + { errorR(Error(FSComp.SR.parsArrowUseIsLimited(),lhs parseState)) SynExpr.YieldOrReturn((true,true),$2, (unionRanges (rhs parseState 1) $2.Range)) } /* END MONADIC SYNTAX ONLY */ @@ -3310,7 +3314,7 @@ declExpr: | declExpr INFIX_COMPARE_OP declExpr { mkSynInfix (rhs parseState 2) $1 $2 $3 } | declExpr DOLLAR declExpr { mkSynInfix (rhs parseState 2) $1 "$" $3 } | declExpr LESS declExpr { mkSynInfix (rhs parseState 2) $1 "<" $3 } - | declExpr LESS recover { if not $3 then reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("<")); + | declExpr LESS recover { if not $3 then reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("<")) exprFromParseError (mkSynInfix (rhs parseState 2) $1 "<" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } | declExpr GREATER declExpr { mkSynInfix (rhs parseState 2) $1 ">" $3 } | declExpr INFIX_AT_HAT_OP declExpr { mkSynInfix (rhs parseState 2) $1 $2 $3 } @@ -3322,45 +3326,45 @@ declExpr: | declExpr INFIX_STAR_DIV_MOD_OP declExpr { mkSynInfix (rhs parseState 2) $1 $2 $3 } | declExpr INFIX_STAR_STAR_OP declExpr { mkSynInfix (rhs parseState 2) $1 $2 $3 } - | declExpr JOIN_IN OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("in")); + | declExpr JOIN_IN OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("in")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 "@in" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr BAR_BAR OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("||")); + | declExpr BAR_BAR OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("||")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 "||" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr INFIX_BAR_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)); + | declExpr INFIX_BAR_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)) exprFromParseError(mkSynInfix (rhs parseState 2) $1 $2 (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr OR OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("or")); + | declExpr OR OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("or")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 "or" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr AMP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("&")); + | declExpr AMP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("&")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 "&" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr AMP_AMP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("&&")); + | declExpr AMP_AMP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("&&")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 "&&" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr INFIX_AMP_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)); + | declExpr INFIX_AMP_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)) exprFromParseError(mkSynInfix (rhs parseState 2) $1 $2 (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr EQUALS OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("=")); + | declExpr EQUALS OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("=")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 "=" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr INFIX_COMPARE_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)); + | declExpr INFIX_COMPARE_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)) exprFromParseError(mkSynInfix (rhs parseState 2) $1 $2 (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr DOLLAR OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("$")); + | declExpr DOLLAR OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("$")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 "$" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr LESS OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("<")); + | declExpr LESS OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("<")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 "<" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr GREATER OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression(">")); + | declExpr GREATER OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression(">")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 ">" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr INFIX_AT_HAT_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)); + | declExpr INFIX_AT_HAT_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)) exprFromParseError(mkSynInfix (rhs parseState 2) $1 $2 (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr PERCENT_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)); + | declExpr PERCENT_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)) exprFromParseError(mkSynInfix (rhs parseState 2) $1 $2 (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr COLON_COLON OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("::")); + | declExpr COLON_COLON OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("::")) SynExpr.App (ExprAtomicFlag.NonAtomic, true, mkSynIdGet (rhs parseState 2) opNameCons,SynExpr.Tuple ([$1;(arbExpr("declExprInfix",(rhs parseState 3).StartRange))],[rhs parseState 2],unionRanges $1.Range (rhs parseState 3).StartRange),unionRanges $1.Range (rhs parseState 3).StartRange) } - | declExpr PLUS_MINUS_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)); + | declExpr PLUS_MINUS_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)) exprFromParseError(mkSynInfix (rhs parseState 2) $1 $2 (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr MINUS OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("-")); + | declExpr MINUS OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("-")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 "-" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr STAR OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("*")); + | declExpr STAR OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression("*")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 "*" (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr INFIX_STAR_DIV_MOD_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)); + | declExpr INFIX_STAR_DIV_MOD_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)) exprFromParseError(mkSynInfix (rhs parseState 2) $1 $2 (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } - | declExpr INFIX_STAR_STAR_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)); + | declExpr INFIX_STAR_STAR_OP OBLOCKEND_COMING_SOON { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)) exprFromParseError(mkSynInfix (rhs parseState 2) $1 $2 (arbExpr("declExprInfix",(rhs parseState 3).StartRange))) } | minusExpr %prec expr_prefix_plus_minus { $1 } @@ -3379,7 +3383,7 @@ withClauses: | OWITH withPatternClauses OEND { rhs parseState 1, $2 } | OWITH withPatternClauses recover - { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileWith()); + { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileWith()) rhs parseState 1, $2 } withPatternClauses: @@ -3452,7 +3456,7 @@ ifExprThen: | OTHEN OBLOCKBEGIN typedSeqExpr oblockend %prec prec_then_if { $3,rhs parseState 1 } | OTHEN OBLOCKBEGIN typedSeqExpr recover %prec prec_then_if - { if not $4 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileThen()); + { if not $4 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileThen()) exprFromParseError $3,rhs parseState 1 } ifExprElifs: @@ -3463,7 +3467,7 @@ ifExprElifs: | OELSE OBLOCKBEGIN typedSeqExpr oblockend { Some $3 } | OELSE OBLOCKBEGIN typedSeqExpr recover - { if not $4 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileElse()); + { if not $4 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileElse()) Some (exprFromParseError $3) } | ELIF declExpr ifExprCases { let mElif = rhs parseState 1 @@ -3490,10 +3494,10 @@ minusExpr: | MINUS minusExpr %prec expr_prefix_plus_minus { mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) "~-" $2 } | PLUS_MINUS_OP minusExpr - { if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt $2.Range (FSComp.SR.parsInvalidPrefixOperator()); + { if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt $2.Range (FSComp.SR.parsInvalidPrefixOperator()) mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) ("~"^($1)) $2 } | ADJACENT_PREFIX_OP minusExpr - { if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt $2.Range (FSComp.SR.parsInvalidPrefixOperator()); + { if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt $2.Range (FSComp.SR.parsInvalidPrefixOperator()) if $1 = "&" then SynExpr.AddressOf(true,$2,rhs parseState 1,unionRanges (rhs parseState 1) $2.Range) elif $1 = "&&" then @@ -3501,7 +3505,7 @@ minusExpr: else mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) ("~"^($1)) $2 } | PERCENT_OP minusExpr - { if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt $2.Range (FSComp.SR.parsInvalidPrefixOperator()); + { if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt $2.Range (FSComp.SR.parsInvalidPrefixOperator()) mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) ("~"^($1)) $2 } | AMP minusExpr { SynExpr.AddressOf(true,$2,rhs parseState 1,unionRanges (rhs parseState 1) $2.Range) } @@ -3530,12 +3534,12 @@ appExpr: argExpr: | ADJACENT_PREFIX_OP atomicExpr { let arg2,hpa2 = $2 - if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt arg2.Range (FSComp.SR.parsInvalidPrefixOperator()); - if hpa2 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsSuccessiveArgsShouldBeSpacedOrTupled()); + if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt arg2.Range (FSComp.SR.parsInvalidPrefixOperator()) + if hpa2 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsSuccessiveArgsShouldBeSpacedOrTupled()) mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) arg2.Range) ("~"^($1)) arg2 } | atomicExpr { let arg,hpa = $1 - if hpa then reportParseErrorAt arg.Range (FSComp.SR.parsSuccessiveArgsShouldBeSpacedOrTupled()); + if hpa then reportParseErrorAt arg.Range (FSComp.SR.parsSuccessiveArgsShouldBeSpacedOrTupled()) arg } @@ -3558,7 +3562,7 @@ atomicExpr: | PREFIX_OP atomicExpr { let arg2,hpa2 = $2 - if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt arg2.Range (FSComp.SR.parsInvalidPrefixOperator()); + if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt arg2.Range (FSComp.SR.parsInvalidPrefixOperator()) mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) arg2.Range) $1 arg2,hpa2 } | atomicExpr DOT atomicExprQualification @@ -3579,13 +3583,13 @@ atomicExpr: | LBRACK listExprElements RBRACK { $2 (lhs parseState) false,false } | LBRACK listExprElements recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracket()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracket()) exprFromParseError ($2 (rhs2 parseState 1 2) false), false } | LBRACK error RBRACK { // silent recovery SynExpr.ArrayOrList(false,[ ], lhs parseState),false } | LBRACK recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracket()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracket()) // silent recovery exprFromParseError (SynExpr.ArrayOrList(false,[ ], rhs parseState 1)),false } | atomicExprAfterType @@ -3597,37 +3601,37 @@ atomicExprQualification: (fun e lhsm dotm -> mkSynDot dotm lhsm e $1) } | /* empty */ { (fun e lhsm dotm -> - reportParseErrorAt dotm (FSComp.SR.parsMissingQualificationAfterDot()); + reportParseErrorAt dotm (FSComp.SR.parsMissingQualificationAfterDot()) let fixedLhsm = mkRange lhsm.FileName lhsm.Start dotm.End // previous lhsm is wrong after 'recover' mkSynDotMissing dotm fixedLhsm e) } | recover { (fun e lhsm dotm -> - reportParseErrorAt dotm (FSComp.SR.parsMissingQualificationAfterDot()); + reportParseErrorAt dotm (FSComp.SR.parsMissingQualificationAfterDot()) let fixedLhsm = mkRange lhsm.FileName lhsm.Start dotm.End // previous lhsm is wrong after 'recover' // Include 'e' in the returned expression but throw it away SynExpr.DiscardAfterMissingQualificationAfterDot(e,fixedLhsm)) } | LPAREN COLON_COLON rparen DOT INT32 { (fun e lhsm dotm -> - libraryOnlyError(lhs parseState); + libraryOnlyError(lhs parseState) SynExpr.LibraryOnlyUnionCaseFieldGet (e,mkSynCaseName lhsm opNameCons,(fst $5),lhsm)) } | LPAREN typedSeqExpr rparen { (fun e lhsm dotm -> - mlCompatWarning (FSComp.SR.parsParenFormIsForML()) (lhs parseState); + mlCompatWarning (FSComp.SR.parsParenFormIsForML()) (lhs parseState) mkSynDotParenGet lhsm dotm e $2) } | LBRACK typedSeqExpr RBRACK { (fun e lhsm dotm -> mkSynDotBrackGet lhsm dotm e $2) } | LBRACK typedSeqExpr recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracket()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracket()) (fun e lhsm dotm -> exprFromParseError (mkSynDotBrackGet lhsm dotm e $2)) } | LBRACK optRangeSeqExpr RBRACK { (fun e lhsm dotm -> mkSynDotBrackSeqSliceGet lhsm dotm e $2) } | LBRACK optRangeSeqExpr recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracket()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracket()) (fun e lhsm dotm -> exprFromParseError (mkSynDotBrackSeqSliceGet lhsm dotm e $2)) } | LBRACK error RBRACK @@ -3711,14 +3715,14 @@ arrayExpr: { $2 (lhs parseState) true } | LBRACK_BAR listExprElements recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracketBar()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracketBar()) exprFromParseError ($2 (rhs2 parseState 1 2) true) } | LBRACK_BAR error BAR_RBRACK { (* silent recovery *) SynExpr.ArrayOrList(true,[ ], lhs parseState) } | LBRACK_BAR recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracketBar()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBracketBar()) (* silent recovery *) exprFromParseError (SynExpr.ArrayOrList(true,[ ], rhs parseState 1)) } @@ -3760,7 +3764,7 @@ parenExpr: arbExpr("parenExpr2obecs", lhsm) } | LPAREN recover %prec prec_atomexpr_lparen_error - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()); + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()) arbExpr("parenExpr2",(lhs parseState)) } // This is really what we should be doing, but it fails because param info expects the range of the expression @@ -3797,7 +3801,7 @@ braceExpr: { let m,r = $2 in r (rhs2 parseState 1 3) } | LBRACE braceExprBody recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBrace()) ; + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBrace()) let m,r = $2 // Note, we can't use 'exprFromParseError' because the extra syntax node interferes with some syntax-directed transformations for computation expressions r (unionRanges (rhs parseState 1) m) } @@ -3807,7 +3811,7 @@ braceExpr: arbExpr("braceExpr",rhs2 parseState 1 3) } | LBRACE recover - { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBrace()) ; + { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBrace()) // Note, we can't use 'exprFromParseError' because the extra syntax node interferes with some syntax-directed transformations for computation expressions SynExpr.Record(None,None,[],rhs parseState 1) } @@ -3851,7 +3855,7 @@ rangeSequenceExpr: { (unionRanges $1.Range $5.Range),(fun _isArray wholem -> mkSynTrifix wholem ".. .." $1 $3 $5) } | declExpr DOT_DOT recover - { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileExpression()); + { if not $3 then reportParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedEndOfFileExpression()) let opm = (rhs parseState 2) let e = arbExpr("rangeSeqError1", (rhs parseState 3).StartRange) (unionRanges $1.Range e.Range),(fun _isArray wholem -> @@ -3888,7 +3892,7 @@ forLoopRange: inlineAssemblyExpr: | HASH stringOrKeywordString opt_inlineAssemblyTypeArg opt_curriedArgExprs opt_inlineAssemblyReturnTypes HASH - { libraryOnlyWarning (lhs parseState); + { libraryOnlyWarning (lhs parseState) let s,sm = $2,rhs parseState 2 (fun m -> SynExpr.LibraryOnlyILAssembly (ParseAssemblyCodeInstructions s sm,$3,List.rev $4,$5,m)) } diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index ea59e6e7238..02c2afdd2ff 100755 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -110,133 +110,140 @@ type ValFlags(flags:int64) = new (recValInfo, baseOrThis, isCompGen, inlineInfo, isMutable, isModuleOrMemberBinding, isExtensionMember, isIncrClassSpecialMember, isTyFunc, allowTypeInst, isGeneratedEventVal) = let flags = (match baseOrThis with - | BaseVal -> 0b000000000000000000L - | CtorThisVal -> 0b000000000000000010L - | NormalVal -> 0b000000000000000100L - | MemberThisVal -> 0b000000000000000110L) ||| - (if isCompGen then 0b000000000000001000L - else 0b000000000000000000L) ||| + | BaseVal -> 0b0000000000000000000L + | CtorThisVal -> 0b0000000000000000010L + | NormalVal -> 0b0000000000000000100L + | MemberThisVal -> 0b0000000000000000110L) ||| + (if isCompGen then 0b0000000000000001000L + else 0b00000000000000000000L) ||| (match inlineInfo with - | ValInline.PseudoVal -> 0b000000000000000000L - | ValInline.Always -> 0b000000000000010000L - | ValInline.Optional -> 0b000000000000100000L - | ValInline.Never -> 0b000000000000110000L) ||| + | ValInline.PseudoVal -> 0b0000000000000000000L + | ValInline.Always -> 0b0000000000000010000L + | ValInline.Optional -> 0b0000000000000100000L + | ValInline.Never -> 0b0000000000000110000L) ||| (match isMutable with - | Immutable -> 0b000000000000000000L - | Mutable -> 0b000000000001000000L) ||| + | Immutable -> 0b0000000000000000000L + | Mutable -> 0b0000000000001000000L) ||| (match isModuleOrMemberBinding with - | false -> 0b000000000000000000L - | true -> 0b000000000010000000L) ||| + | false -> 0b0000000000000000000L + | true -> 0b0000000000010000000L) ||| (match isExtensionMember with - | false -> 0b000000000000000000L - | true -> 0b000000000100000000L) ||| + | false -> 0b0000000000000000000L + | true -> 0b0000000000100000000L) ||| (match isIncrClassSpecialMember with - | false -> 0b000000000000000000L - | true -> 0b000000001000000000L) ||| + | false -> 0b0000000000000000000L + | true -> 0b0000000001000000000L) ||| (match isTyFunc with - | false -> 0b000000000000000000L - | true -> 0b000000010000000000L) ||| + | false -> 0b0000000000000000000L + | true -> 0b0000000010000000000L) ||| (match recValInfo with - | ValNotInRecScope -> 0b000000000000000000L - | ValInRecScope true -> 0b000000100000000000L - | ValInRecScope false -> 0b000001000000000000L) ||| + | ValNotInRecScope -> 0b0000000000000000000L + | ValInRecScope true -> 0b0000000100000000000L + | ValInRecScope false -> 0b0000001000000000000L) ||| (match allowTypeInst with - | false -> 0b000000000000000000L - | true -> 0b000100000000000000L) ||| + | false -> 0b0000000000000000000L + | true -> 0b0000100000000000000L) ||| (match isGeneratedEventVal with - | false -> 0b000000000000000000L - | true -> 0b100000000000000000L) + | false -> 0b0000000000000000000L + | true -> 0b0100000000000000000L) ValFlags(flags) member x.BaseOrThisInfo = - match (flags &&& 0b000000000000000110L) with - | 0b000000000000000000L -> BaseVal - | 0b000000000000000010L -> CtorThisVal - | 0b000000000000000100L -> NormalVal - | 0b000000000000000110L -> MemberThisVal + match (flags &&& 0b0000000000000000110L) with + | 0b0000000000000000000L -> BaseVal + | 0b0000000000000000010L -> CtorThisVal + | 0b0000000000000000100L -> NormalVal + | 0b0000000000000000110L -> MemberThisVal | _ -> failwith "unreachable" - member x.IsCompilerGenerated = (flags &&& 0b000000000000001000L) <> 0x0L + member x.IsCompilerGenerated = (flags &&& 0b0000000000000001000L) <> 0x0L member x.SetIsCompilerGenerated(isCompGen) = - let flags = (flags &&& ~~~0b000000000000001000L) ||| + let flags = (flags &&& ~~~0b0000000000000001000L) ||| (match isCompGen with - | false -> 0b000000000000000000L - | true -> 0b000000000000001000L) + | false -> 0b0000000000000000000L + | true -> 0b0000000000000001000L) ValFlags(flags) member x.InlineInfo = - match (flags &&& 0b000000000000110000L) with - | 0b000000000000000000L -> ValInline.PseudoVal - | 0b000000000000010000L -> ValInline.Always - | 0b000000000000100000L -> ValInline.Optional - | 0b000000000000110000L -> ValInline.Never + match (flags &&& 0b0000000000000110000L) with + | 0b0000000000000000000L -> ValInline.PseudoVal + | 0b0000000000000010000L -> ValInline.Always + | 0b0000000000000100000L -> ValInline.Optional + | 0b0000000000000110000L -> ValInline.Never | _ -> failwith "unreachable" member x.MutabilityInfo = - match (flags &&& 0b000000000001000000L) with - | 0b000000000000000000L -> Immutable - | 0b000000000001000000L -> Mutable + match (flags &&& 0b0000000000001000000L) with + | 0b0000000000000000000L -> Immutable + | 0b0000000000001000000L -> Mutable | _ -> failwith "unreachable" member x.IsMemberOrModuleBinding = - match (flags &&& 0b000000000010000000L) with - | 0b000000000000000000L -> false - | 0b000000000010000000L -> true + match (flags &&& 0b0000000000010000000L) with + | 0b0000000000000000000L -> false + | 0b0000000000010000000L -> true | _ -> failwith "unreachable" - member x.SetIsMemberOrModuleBinding = ValFlags(flags ||| 0b000000000010000000L) + member x.SetIsMemberOrModuleBinding = ValFlags(flags ||| 0b0000000000010000000L) - member x.IsExtensionMember = (flags &&& 0b000000000100000000L) <> 0L - member x.IsIncrClassSpecialMember = (flags &&& 0b000000001000000000L) <> 0L - member x.IsTypeFunction = (flags &&& 0b000000010000000000L) <> 0L + member x.IsExtensionMember = (flags &&& 0b0000000000100000000L) <> 0L + member x.IsIncrClassSpecialMember = (flags &&& 0b0000000001000000000L) <> 0L + member x.IsTypeFunction = (flags &&& 0b0000000010000000000L) <> 0L - member x.RecursiveValInfo = match (flags &&& 0b000001100000000000L) with - | 0b000000000000000000L -> ValNotInRecScope - | 0b000000100000000000L -> ValInRecScope(true) - | 0b000001000000000000L -> ValInRecScope(false) + member x.RecursiveValInfo = match (flags &&& 0b0000001100000000000L) with + | 0b0000000000000000000L -> ValNotInRecScope + | 0b0000000100000000000L -> ValInRecScope(true) + | 0b0000001000000000000L -> ValInRecScope(false) | _ -> failwith "unreachable" member x.SetRecursiveValInfo(recValInfo) = let flags = - (flags &&& ~~~0b000001100000000000L) ||| + (flags &&& ~~~0b0000001100000000000L) ||| (match recValInfo with - | ValNotInRecScope -> 0b000000000000000000L - | ValInRecScope(true) -> 0b000000100000000000L - | ValInRecScope(false) -> 0b000001000000000000L) + | ValNotInRecScope -> 0b0000000000000000000L + | ValInRecScope(true) -> 0b0000000100000000000L + | ValInRecScope(false) -> 0b0000001000000000000L) ValFlags(flags) - member x.MakesNoCriticalTailcalls = (flags &&& 0b000010000000000000L) <> 0L + member x.MakesNoCriticalTailcalls = (flags &&& 0b0000010000000000000L) <> 0L - member x.SetMakesNoCriticalTailcalls = ValFlags(flags ||| 0b000010000000000000L) + member x.SetMakesNoCriticalTailcalls = ValFlags(flags ||| 0b0000010000000000000L) - member x.PermitsExplicitTypeInstantiation = (flags &&& 0b000100000000000000L) <> 0L - member x.HasBeenReferenced = (flags &&& 0b001000000000000000L) <> 0L + member x.PermitsExplicitTypeInstantiation = (flags &&& 0b0000100000000000000L) <> 0L + member x.HasBeenReferenced = (flags &&& 0b0001000000000000000L) <> 0L - member x.SetHasBeenReferenced = ValFlags(flags ||| 0b001000000000000000L) + member x.SetHasBeenReferenced = ValFlags(flags ||| 0b0001000000000000000L) - member x.IsCompiledAsStaticPropertyWithoutField = (flags &&& 0b010000000000000000L) <> 0L + member x.IsCompiledAsStaticPropertyWithoutField = (flags &&& 0b0010000000000000000L) <> 0L - member x.SetIsCompiledAsStaticPropertyWithoutField = ValFlags(flags ||| 0b010000000000000000L) + member x.SetIsCompiledAsStaticPropertyWithoutField = ValFlags(flags ||| 0b0010000000000000000L) - member x.IsGeneratedEventVal = (flags &&& 0b100000000000000000L) <> 0L + + member x.IsGeneratedEventVal = (flags &&& 0b0100000000000000000L) <> 0L + + member x.IsFixed = (flags &&& 0b1000000000000000000L) <> 0L + + member x.SetIsFixed = ValFlags(flags ||| 0b1000000000000000000L) + + /// Get the flags as included in the F# binary metadata member x.PickledBits = // Clear the RecursiveValInfo, only used during inference and irrelevant across assembly boundaries // 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 &&& ~~~0b011001100000000000L) + (flags &&& ~~~0b0011001100000000000L) /// Represents the kind of a type parameter [] @@ -350,12 +357,12 @@ type TyparFlags(flags:int32) = [] type EntityFlags(flags:int64) = - new (usesPrefixDisplay, isModuleOrNamespace, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, isStructRecordType) = + new (usesPrefixDisplay, isModuleOrNamespace, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, isStructRecordOrUnionType) = EntityFlags((if isModuleOrNamespace then 0b00000000001L else 0L) ||| (if usesPrefixDisplay then 0b00000000010L else 0L) ||| (if preEstablishedHasDefaultCtor then 0b00000000100L else 0L) ||| (if hasSelfReferentialCtor then 0b00000001000L else 0L) ||| - (if isStructRecordType then 0b00000100000L else 0L)) + (if isStructRecordOrUnionType then 0b00000100000L else 0L)) member x.IsModuleOrNamespace = (flags &&& 0b00000000001L) <> 0x0L member x.IsPrefixDisplay = (flags &&& 0b00000000010L) <> 0x0L @@ -370,7 +377,7 @@ type EntityFlags(flags:int64) = member x.HasSelfReferentialConstructor = (flags &&& 0b00000001000L) <> 0x0L /// This bit represents a F# record that is a value type, or a struct record. - member x.IsStructRecordType = (flags &&& 0b00000100000L) <> 0x0L + member x.IsStructRecordOrUnionType = (flags &&& 0b00000100000L) <> 0x0L /// This bit is reserved for us in the pickle format, see pickle.fs, it's being listed here to stop it ever being used for anything else static member ReservedBitForPickleFormatTyconReprFlag = 0b00000010000L @@ -776,7 +783,7 @@ type Entity = member x.IsRecordTycon = match x.TypeReprInfo with | TRecdRepr _ -> true | _ -> false /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition that is a value type. - member x.IsStructRecordTycon = match x.TypeReprInfo with | TRecdRepr _ -> x.Data.entity_flags.IsStructRecordType | _ -> false + member x.IsStructRecordOrUnionTycon = match x.TypeReprInfo with TRecdRepr _ | TUnionRepr _ -> x.Data.entity_flags.IsStructRecordOrUnionType | _ -> false /// 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 @@ -822,7 +829,8 @@ type Entity = /// Indicates if this is an F#-defined struct or enum type definition , i.e. a value type definition member x.IsFSharpStructOrEnumTycon = match x.TypeReprInfo with - | TRecdRepr _ -> x.IsStructRecordTycon + | TRecdRepr _ -> x.IsStructRecordOrUnionTycon + | TUnionRepr _ -> x.IsStructRecordOrUnionTycon | TFSharpObjectRepr info -> match info.fsobjmodel_kind with | TTyconClass | TTyconInterface | TTyconDelegate _ -> false @@ -963,8 +971,8 @@ type Entity = /// Set the custom attributes on an F# type definition. member x.SetAttribs attribs = x.Data.entity_attribs <- attribs - /// Sets the rigidity of a type variable - member x.SetIsStructRecordType b = let x = x.Data in let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) + /// Sets the structness of a record or union type definition + member x.SetIsStructRecordOrUnion b = let x = x.Data in let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) and @@ -1733,7 +1741,7 @@ and Construct = entity_kind=kind entity_range=m entity_other_range=None - entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false,preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false, isStructRecordType=false) + entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false,preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false, isStructRecordOrUnionType=false) entity_attribs=[] // fetched on demand via est.fs API entity_typars= LazyWithContext.NotLazy [] entity_tycon_abbrev = None @@ -1762,7 +1770,7 @@ and Construct = entity_stamp=stamp entity_kind=TyparKind.Type entity_modul_contents = mtype - entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=true, preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false,isStructRecordType=false) + entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=true, preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false,isStructRecordOrUnionType=false) entity_typars=LazyWithContext.NotLazy [] entity_tycon_abbrev = None entity_tycon_repr = TNoRepr @@ -2190,6 +2198,9 @@ and /// Indicates if the backing field for a static value is suppressed. member x.IsCompiledAsStaticPropertyWithoutField = x.Data.val_flags.IsCompiledAsStaticPropertyWithoutField + /// Indicates if the value is pinned/fixed + member x.IsFixed = x.Data.val_flags.IsFixed + /// 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.Data.val_flags.PermitsExplicitTypeInstantiation @@ -2382,6 +2393,7 @@ and member x.SetMakesNoCriticalTailcalls() = x.Data.val_flags <- x.Data.val_flags.SetMakesNoCriticalTailcalls member x.SetHasBeenReferenced() = x.Data.val_flags <- x.Data.val_flags.SetHasBeenReferenced member x.SetIsCompiledAsStaticPropertyWithoutField() = x.Data.val_flags <- x.Data.val_flags.SetIsCompiledAsStaticPropertyWithoutField + member x.SetIsFixed() = x.Data.val_flags <- x.Data.val_flags.SetIsFixed member x.SetValReprInfo info = x.Data.val_repr_info <- info member x.SetType ty = x.Data.val_type <- ty member x.SetOtherRange m = x.Data.val_other_range <- Some m @@ -3576,15 +3588,16 @@ and /// TDSwitch(input, cases, default, range) /// /// Indicates a decision point in a decision tree. - /// input -- the expression being tested - /// cases -- the list of tests and their subsequent decision trees - /// default -- the default decision tree, if any + /// input -- The expression being tested. If switching over a struct union this + /// must be the address of the expression being tested. + /// cases -- The list of tests and their subsequent decision trees + /// default -- The default decision tree, if any /// range -- (precise documentation needed) | TDSwitch of Expr * DecisionTreeCase list * DecisionTree option * range /// TDSuccess(results, targets) /// - /// Indicates the decision tree has terminated with success, calling the given target with the given parameters. + /// Indicates the decision tree has terminated with success, transferring control to the given target with the given parameters. /// results -- the expressions to be bound to the variables at the target /// target -- the target number for the continuation | TDSuccess of FlatExprs * int @@ -3828,6 +3841,8 @@ and | UnionCaseProof of UnionCaseRef /// An operation representing a field-get from a union value, where that value has been proven to be of the corresponding union case. | UnionCaseFieldGet of UnionCaseRef * int + /// An operation representing a field-get from a union value, where that value has been proven to be of the corresponding union case. + | UnionCaseFieldGetAddr of UnionCaseRef * int /// An operation representing a field-get from a union value. The value is not assumed to have been proven to be of the corresponding union case. | UnionCaseFieldSet of UnionCaseRef * int /// An operation representing a field-get from an F# exception value. @@ -4573,7 +4588,7 @@ let NewExn cpath (id:Ident) access repr attribs doc = entity_typars=LazyWithContext.NotLazy [] entity_tycon_abbrev = None entity_tycon_repr = TNoRepr - entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false, preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false, isStructRecordType=false) + entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false, preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false, isStructRecordOrUnionType=false) entity_il_repr_cache= newCache() } let NewRecdField stat konst id ty isMutable isVolatile pattribs fattribs docOption access secret = @@ -4601,7 +4616,7 @@ let NewTycon (cpath, nm, m, access, reprAccess, kind, typars, docOption, usesPre entity_kind=kind entity_range=m entity_other_range=None - entity_flags=EntityFlags(usesPrefixDisplay=usesPrefixDisplay, isModuleOrNamespace=false,preEstablishedHasDefaultCtor=preEstablishedHasDefaultCtor, hasSelfReferentialCtor=hasSelfReferentialCtor, isStructRecordType=false) + entity_flags=EntityFlags(usesPrefixDisplay=usesPrefixDisplay, isModuleOrNamespace=false,preEstablishedHasDefaultCtor=preEstablishedHasDefaultCtor, hasSelfReferentialCtor=hasSelfReferentialCtor, isStructRecordOrUnionType=false) entity_attribs=[] // fixed up after entity_typars=typars entity_tycon_abbrev = None diff --git a/src/fsharp/vs/IncrementalBuild.fs b/src/fsharp/vs/IncrementalBuild.fs index 31137588084..0db1e3f6e5b 100755 --- a/src/fsharp/vs/IncrementalBuild.fs +++ b/src/fsharp/vs/IncrementalBuild.fs @@ -12,6 +12,7 @@ open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL +open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.CompileOps @@ -1063,8 +1064,6 @@ module IncrementalBuilderEventTesting = module Tc = Microsoft.FSharp.Compiler.TypeChecker -open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics -open Internal.Utilities.Debug /// Accumulated results of type checking. [] diff --git a/src/fsharp/vs/ServiceLexing.fs b/src/fsharp/vs/ServiceLexing.fs index 6ec28b08a2f..295a380af14 100755 --- a/src/fsharp/vs/ServiceLexing.fs +++ b/src/fsharp/vs/ServiceLexing.fs @@ -18,7 +18,6 @@ open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Lexhelp open Microsoft.FSharp.Compiler.Lib -open Internal.Utilities.Debug type Position = int * int type Range = Position * Position @@ -248,7 +247,7 @@ module internal TokenClassifications = | FINALLY | LAZY | MATCH | MUTABLE | NEW | OF | OPEN | OR | VOID | EXTERN | INTERFACE | REC | TO | TRUE | TRY | TYPE | VAL | INLINE | WHEN | WHILE | WITH | IF | THEN | ELSE | DO | DONE | LET(_) | IN (*| NAMESPACE*) | CONST - | HIGH_PRECEDENCE_PAREN_APP + | HIGH_PRECEDENCE_PAREN_APP | FIXED | HIGH_PRECEDENCE_BRACK_APP | TYPE_COMING_SOON | TYPE_IS_HERE | MODULE_COMING_SOON | MODULE_IS_HERE -> (FSharpTokenColorKind.Keyword,FSharpTokenCharKind.Keyword,FSharpTokenTriggerClass.None) @@ -552,9 +551,9 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, do match filename with - | None -> lexbuf.EndPos <- Internal.Utilities.Text.Lexing.Position.Empty - | Some(value) -> resetLexbufPos value lexbuf - + | None -> lexbuf.EndPos <- Internal.Utilities.Text.Lexing.Position.Empty + | Some(value) -> resetLexbufPos value lexbuf + member x.ScanToken(lexintInitial) : Option * FSharpTokenizerLexState = use unwindBP = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) @@ -651,9 +650,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, | EOF lexcont -> // End of text! No more tokens. None,lexcont,0 - | LEX_FAILURE s -> - // REVIEW: report this error - Trace.PrintLine("Lexing", fun _ -> sprintf "LEX_FAILURE:%s\n" s) + | LEX_FAILURE _ -> None, LexerStateEncoding.revertToDefaultLexCont, 0 | _ -> // Get the information about the token diff --git a/src/fsharp/vs/ServiceParamInfoLocations.fs b/src/fsharp/vs/ServiceParamInfoLocations.fs index df0ca0bc404..7f29854c4bc 100755 --- a/src/fsharp/vs/ServiceParamInfoLocations.fs +++ b/src/fsharp/vs/ServiceParamInfoLocations.fs @@ -2,7 +2,6 @@ namespace Microsoft.FSharp.Compiler.SourceCodeServices -open Internal.Utilities.Debug open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Ast @@ -104,7 +103,6 @@ module internal NoteworthyParamInfoLocationsImpl = if AstTraversal.rangeContainsPosEdgesExclusive parenRange pos then let commasAndCloseParen = ((synExprList,commaRanges@[parenRange]) ||> List.map2 (fun e c -> c.End, getNamedParamName e)) let r = Found (parenRange.Start, commasAndCloseParen, rpRangeOpt.IsSome) - Trace.PrintLine("LanguageServiceParamInfo", fun () -> sprintf "Found paren tuple ranges %+A from %+A" r expr) r, None else NotFound, None @@ -124,7 +122,6 @@ module internal NoteworthyParamInfoLocationsImpl = | SynExpr.ArbitraryAfterError(_debugStr, range) -> // single argument when e.g. after open paren you hit EOF if AstTraversal.rangeContainsPosEdgesExclusive range pos then let r = Found (range.Start, [range.End, null], false) - Trace.PrintLine("LanguageServiceParamInfo", fun () -> sprintf "Found ArbitraryAfterError range %+A from %+A" r expr) r, None else NotFound, None @@ -132,7 +129,6 @@ module internal NoteworthyParamInfoLocationsImpl = | SynExpr.Const(SynConst.Unit, unitRange) -> if AstTraversal.rangeContainsPosEdgesExclusive unitRange pos then let r = Found (unitRange.Start, [unitRange.End, null], true) - Trace.PrintLine("LanguageServiceParamInfo", fun () -> sprintf "Found unit range %+A from %+A" r expr) r, None else NotFound, None @@ -203,7 +199,6 @@ module internal NoteworthyParamInfoLocationsImpl = if isInfix then // This seems to be an infix operator, since the start of the argument is a position earlier than the end of the long-id being applied to it. // For now, we don't support infix operators. - Trace.PrintLine("LanguageServiceParamInfo", fun () -> sprintf "Found apparent infix operator, ignoring dug-out ident from %+A" expr) None else Some (FSharpNoteworthyParamInfoLocations(lid, lidRange, parenLoc, args |> List.map fst, isThereACloseParen, args |> List.map snd)) @@ -212,7 +207,7 @@ module internal NoteworthyParamInfoLocationsImpl = | _ -> traverseSynExpr synExpr2 // ID and error recovery of these - | SynExpr.TypeApp(synExpr, openm, tyArgs, commas, closemOpt, _, wholem) as seta -> + | SynExpr.TypeApp(synExpr, openm, tyArgs, commas, closemOpt, _, wholem) -> match traverseSynExpr synExpr with | Some _ as r -> r | None -> @@ -220,7 +215,6 @@ module internal NoteworthyParamInfoLocationsImpl = if AstTraversal.rangeContainsPosEdgesExclusive typeArgsm pos && tyArgs |> List.forall isStaticArg then let commasAndCloseParen = [ for c in commas -> c.End ] @ [ wholem.End ] let r = FSharpNoteworthyParamInfoLocations(["dummy"], synExpr.Range, openm.Start, commasAndCloseParen, closemOpt.IsSome, tyArgs |> List.map digOutIdentFromStaticArg) - Trace.PrintLine("LanguageServiceParamInfo", fun () -> sprintf "Found SynExpr.TypeApp with ranges %+A from %+A" r seta) Some r else None diff --git a/src/fsharp/vs/ServiceParseTreeWalk.fs b/src/fsharp/vs/ServiceParseTreeWalk.fs index 792af9f4bf6..2f93adbb52e 100755 --- a/src/fsharp/vs/ServiceParseTreeWalk.fs +++ b/src/fsharp/vs/ServiceParseTreeWalk.fs @@ -317,6 +317,7 @@ module internal AstTraversal = |> pick expr | SynExpr.Do(synExpr, _range) -> traverseSynExpr synExpr | SynExpr.Assert(synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.Fixed(synExpr, _range) -> traverseSynExpr synExpr | SynExpr.App(_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) -> if isInfix then [dive synExpr2 synExpr2.Range traverseSynExpr diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs index 41b0b212799..67585e840a9 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fs +++ b/src/fsharp/vs/ServiceUntypedParse.fs @@ -19,8 +19,6 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.CompileOps open Microsoft.FSharp.Compiler.Lib -open Internal.Utilities.Debug - /// Methods for dealing with F# sources files. module internal SourceFile = /// Source file extensions @@ -98,7 +96,6 @@ type FSharpParseFileResults(errors : FSharpErrorInfo[], input : Ast.ParsedInput ErrorScope.Protect Range.range0 (fun () -> - use t = Trace.Call("CompilerServices", "GetNavigationItems", fun _ -> "") match input with | Some(ParsedInput.ImplFile(ParsedImplFileInput(_modname,_isScript,_qualName,_pragmas,_hashDirectives,modules,_isLastCompiland))) -> NavigationImpl.getNavigationFromImplFile modules @@ -171,6 +168,7 @@ type FSharpParseFileResults(errors : FSharpErrorInfo[], input : Ast.ParsedInput | SynExpr.DiscardAfterMissingQualificationAfterDot (e,_) | SynExpr.Do (e,_) | SynExpr.Assert (e,_) + | SynExpr.Fixed (e,_) | SynExpr.DotGet (e,_,_,_) | SynExpr.LongIdentSet (_,e,_) | SynExpr.New (_,_,e,_) @@ -363,12 +361,10 @@ type FSharpParseFileResults(errors : FSharpErrorInfo[], input : Ast.ParsedInput // Get items for the navigation drop down bar member scope.GetNavigationItems() = - use t = Trace.Call("SyncOp","GetNavigationItems", fun _->"") // This does not need to be run on the background thread scope.GetNavigationItemsImpl() member scope.ValidateBreakpointLocation(pos) = - use t = Trace.Call("SyncOp","ValidateBreakpointLocation", fun _->"") // This does not need to be run on the background thread scope.ValidateBreakpointLocationImpl(pos) diff --git a/src/fsharp/vs/Symbols.fs b/src/fsharp/vs/Symbols.fs index dd901b5257e..28eb96a5693 100644 --- a/src/fsharp/vs/Symbols.fs +++ b/src/fsharp/vs/Symbols.fs @@ -1531,7 +1531,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = match d with | P p -> - [ [ for (ParamData(isParamArrayArg,isOutArg,optArgInfo,nmOpt,_reflArgInfo,pty)) in p.GetParamDatas(cenv.amap,range0) do + [ [ for (ParamData(isParamArrayArg,isOutArg,optArgInfo,_callerInfoInfo,nmOpt,_reflArgInfo,pty)) in p.GetParamDatas(cenv.amap,range0) do // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for // either .NET or F# parameters let argInfo : ArgReprInfo = { Name=nmOpt; Attribs= [] } @@ -1543,7 +1543,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | M m -> [ for argtys in m.GetParamDatas(cenv.amap,range0,m.FormalMethodInst) do yield - [ for (ParamData(isParamArrayArg,isOutArg,optArgInfo,nmOpt,_reflArgInfo,pty)) in argtys do + [ for (ParamData(isParamArrayArg,isOutArg,optArgInfo,_callerInfoInfo,nmOpt,_reflArgInfo,pty)) in argtys do // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for // either .NET or F# parameters let argInfo : ArgReprInfo = { Name=nmOpt; Attribs= [] } diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 58fdfae12e8..5a909015864 100755 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -39,13 +39,11 @@ open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.InfoReader open Microsoft.FSharp.Compiler.NameResolution open Microsoft.FSharp.Compiler.TypeChecker +open Microsoft.FSharp.Compiler.SourceCodeServices.ItemDescriptionsImpl -open Internal.Utilities.Collections -open Internal.Utilities.Debug open Internal.Utilities -open Internal.Utilities.StructuredFormat +open Internal.Utilities.Collections -open Microsoft.FSharp.Compiler.SourceCodeServices.ItemDescriptionsImpl [] module EnvMisc = @@ -88,13 +86,13 @@ module internal Params = let ParamOfUnionCaseField g denv isGenerated (i : int) f = let initial = ParamOfRecdField g denv f - let display = if isGenerated i f then initial.Display else NicePrint.stringOfParamData denv (ParamData(false, false, NotOptional, Some f.rfield_id, ReflectedArgInfo.None, f.rfield_type)) + let display = if isGenerated i f then initial.Display else NicePrint.stringOfParamData denv (ParamData(false, false, NotOptional, NoCallerInfo, Some f.rfield_id, ReflectedArgInfo.None, f.rfield_type)) FSharpMethodGroupItemParameter( name=initial.ParameterName, canonicalTypeTextForSorting=initial.CanonicalTypeTextForSorting, display=display) - let ParamOfParamData g denv (ParamData(_isParamArrayArg, _isOutArg, _optArgInfo, nmOpt, _reflArgInfo, pty) as paramData) = + let ParamOfParamData g denv (ParamData(_isParamArrayArg, _isOutArg, _optArgInfo, _callerInfoInfo, nmOpt, _reflArgInfo, pty) as paramData) = FSharpMethodGroupItemParameter( name = (match nmOpt with None -> "" | Some pn -> pn.idText), canonicalTypeTextForSorting = printCanonicalizedTypeName g denv pty, @@ -104,7 +102,7 @@ module internal Params = let ParamsOfParamDatas g denv (paramDatas:ParamData list) rty = let paramNames,paramPrefixes,paramTypes = paramDatas - |> List.map (fun (ParamData(isParamArrayArg, _isOutArg, optArgInfo, nmOpt, _reflArgInfo, pty)) -> + |> List.map (fun (ParamData(isParamArrayArg, _isOutArg, optArgInfo, _callerInfoInfo, nmOpt, _reflArgInfo, pty)) -> let isOptArg = optArgInfo.IsOptional match nmOpt, isOptArg, tryDestOptionTy denv.g pty with // Layout an optional argument @@ -251,7 +249,7 @@ module internal Params = let paramDatas = argInfo |> List.map ParamNameAndType.FromArgInfo - |> List.map (fun (ParamNameAndType(nmOpt, pty)) -> ParamData(false, false, NotOptional, nmOpt, ReflectedArgInfo.None, pty)) + |> List.map (fun (ParamNameAndType(nmOpt, pty)) -> ParamData(false, false, NotOptional, NoCallerInfo, nmOpt, ReflectedArgInfo.None, pty)) ParamsOfParamDatas g denv paramDatas returnTy | Item.UnionCase(ucr,_) -> match ucr.UnionCase.RecdFields with @@ -281,7 +279,7 @@ module internal Params = | None -> let argNamesAndTys = ItemDescriptionsImpl.ParamNameAndTypesOfUnaryCustomOperation g minfo let _, argTys, _ = PrettyTypes.PrettifyTypesN g (argNamesAndTys |> List.map (fun (ParamNameAndType(_,ty)) -> ty)) - let paramDatas = (argNamesAndTys, argTys) ||> List.map2 (fun (ParamNameAndType(nmOpt, _)) argTy -> ParamData(false, false, NotOptional, nmOpt, ReflectedArgInfo.None,argTy)) + let paramDatas = (argNamesAndTys, argTys) ||> List.map2 (fun (ParamNameAndType(nmOpt, _)) argTy -> ParamData(false, false, NotOptional, NoCallerInfo, nmOpt, ReflectedArgInfo.None,argTy)) let rty = minfo.GetFSharpReturnTy(amap, m, minfo.FormalMethodInst) ParamsOfParamDatas g denv paramDatas rty | Some _ -> @@ -290,7 +288,7 @@ module internal Params = | Item.FakeInterfaceCtor _ -> [] | Item.DelegateCtor delty -> let (SigOfFunctionForDelegate(_, _, _, fty)) = GetSigOfFunctionForDelegate infoReader delty m AccessibleFromSomeFSharpCode - ParamsOfParamDatas g denv [ParamData(false, false, NotOptional, None, ReflectedArgInfo.None, fty)] delty + ParamsOfParamDatas g denv [ParamData(false, false, NotOptional, NoCallerInfo, None, ReflectedArgInfo.None, fty)] delty | _ -> [] @@ -571,7 +569,6 @@ type TypeCheckInfo |> FilterItemsForCtors filterCtors if nonNil items then - Trace.PrintLine("CompilerServicesVerbose", fun () -> sprintf "GetPreciseItemsFromNameResolution: Results in %d items!\n" items.Length) if hasTextChangedSinceLastTypecheck(textSnapshotInfo, m) then NameResResult.TypecheckStaleAndTextChanged // typecheck is stale, wait for second-chance IntelliSense to bring up right result else @@ -579,7 +576,6 @@ type TypeCheckInfo else NameResResult.Empty let GetCapturedNameResolutions endOfNamesPos resolveOverloads = - Trace.PrintLine("CompilerServicesVerbose", fun () -> sprintf "GetPreciseItemsFromNameResolution: endOfNamesPos = %s\n" (stringOfPos endOfNamesPos)) let quals = match resolveOverloads with @@ -596,7 +592,6 @@ type TypeCheckInfo let GetPreciseItemsFromNameResolution(line, colAtEndOfNames, membersByResidue, filterCtors, resolveOverloads, hasTextChangedSinceLastTypecheck) = let endOfNamesPos = mkPos line colAtEndOfNames - Trace.PrintLine("CompilerServicesVerbose", fun () -> sprintf "GetPreciseItemsFromNameResolution: endOfNamesPos = %s\n" (stringOfPos endOfNamesPos)) // Logic below expects the list to be in reverse order of resolution let items = GetCapturedNameResolutions endOfNamesPos resolveOverloads |> ResizeArray.toList |> List.rev @@ -653,7 +648,7 @@ type TypeCheckInfo methods |> List.collect (fun meth -> match meth.GetParamDatas(amap, m, meth.FormalMethodInst) with - | x::_ -> x |> List.choose(fun (ParamData(_isParamArray, _isOut, _optArgInfo, name, _, ty)) -> + | x::_ -> x |> List.choose(fun (ParamData(_isParamArray, _isOut, _optArgInfo, _callerInfoInfo, name, _, ty)) -> match name with | Some n -> Some (Item.ArgName(n, ty, Some (ArgumentContainer.Method meth))) | None -> None @@ -902,14 +897,13 @@ type TypeCheckInfo | NameResResult.TypecheckStaleAndTextChanged -> None // second-chance intellisense will try again | NameResResult.Cancel(denv,m) -> Some([], denv, m) | NameResResult.Members(FilterRelevantItems exactMatchResidueOpt items) -> - Trace.PrintLine("CompilerServices", fun _ -> sprintf "GetDeclItemsForNamesAtPosition: lookup based on name resolution results successful, #items = %d, exists ctor = %b\n" (p13 items).Length (items |> p13 |> List.exists (function Item.CtorGroup _ -> true | _ -> false))) + // lookup based on name resolution results successful Some items | _ -> match origLongIdentOpt with | None -> None | Some _ -> - Trace.PrintLine("CompilerServices", fun _ -> sprintf "GetDeclItemsForNamesAtPosition: plid = %+A, residue = %+A, colAtEndOfNamesAndResidue = %+A\n" plid exactMatchResidueOpt colAtEndOfNamesAndResidue) // Try to use the type of the expression on the left to help generate a completion list let qualItems, thereIsADotInvolved = @@ -939,7 +933,7 @@ type TypeCheckInfo // and then return to the qualItems. This is because the expression typings are a little inaccurate, primarily because // it appears we're getting some typings recorded for non-atomic expressions like "f x" when (match plid with [] -> true | _ -> false) -> - Trace.PrintLine("CompilerServices", fun _ -> sprintf "GetDeclItemsForNamesAtPosition: lookup based on expression typings successful\n") + // lookup based on expression typings successful Some items | GetPreciseCompletionListFromExprTypingsResult.NoneBecauseThereWereTypeErrors, _ -> // There was an error, e.g. we have "." and there is an error determining the type of @@ -961,13 +955,13 @@ type TypeCheckInfo // First, use unfiltered name resolution items, if they're not empty | NameResResult.Members(items, denv, m), _, _ when nonNil items -> - Trace.PrintLine("CompilerServices", fun _ -> sprintf "GetDeclItemsForNamesAtPosition: lookup based on name resolution results successful, #items = %d, exists ctor = %b\n" (items).Length (items |> List.exists (function Item.CtorGroup _ -> true | _ -> false))) + // lookup based on name resolution results successful Some(items, denv, m) // If we have nonempty items from environment that were resolved from a type, then use them... // (that's better than the next case - here we'd return 'int' as a type) | _, FilterRelevantItems exactMatchResidueOpt (items, denv, m), _ when nonNil items -> - Trace.PrintLine("CompilerServices", fun _ -> sprintf "GetDeclItemsForNamesAtPosition: lookup based on name and environment successful\n") + // lookup based on name and environment successful Some(items, denv, m) // Try again with the qualItems @@ -2467,7 +2461,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun let useFsiAuxLib = defaultArg useFsiAuxLib true // Do we use a "FSharp.Core, 4.3.0.0" reference by default? let otherFlags = defaultArg otherFlags [| |] - let useMonoResolution = + let useSimpleResolution = #if ENABLE_MONO_SUPPORT runningOnMono || otherFlags |> Array.exists (fun x -> x = "--simpleresolution") #else @@ -2478,7 +2472,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun let collect _name = () let fsiCompilerOptions = CompileOptions.GetCoreFsiCompilerOptions tcConfigB CompileOptions.ParseCompilerOptions (collect, fsiCompilerOptions, Array.toList otherFlags) - let fas = LoadClosure.ComputeClosureOfSourceText(filename, source, CodeContext.Editing, useMonoResolution, useFsiAuxLib, new Lexhelp.LexResourceManager(), applyCompilerOptions) + let fas = LoadClosure.ComputeClosureOfSourceText(filename, source, CodeContext.Editing, useSimpleResolution, useFsiAuxLib, new Lexhelp.LexResourceManager(), applyCompilerOptions) let otherFlags = [| yield "--noframework"; yield "--warn:3"; yield! otherFlags diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index 2f9320cbcbd..45bd2fa2d51 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -522,7 +522,7 @@ type internal FSharpChecker = /// This function is called when the configuration is known to have changed for reasons not encoded in the ProjectOptions. /// For example, dependent references may have been deleted or created. member InvalidateConfiguration: options: FSharpProjectOptions -> unit - + /// Begin background parsing the given project. member StartBackgroundCompile: options: FSharpProjectOptions -> unit diff --git a/src/ilx/EraseUnions.fs b/src/ilx/EraseUnions.fs index fac033126f9..6edcb4c663b 100644 --- a/src/ilx/EraseUnions.fs +++ b/src/ilx/EraseUnions.fs @@ -39,8 +39,7 @@ type DiscriminationTechnique = // class (no subclasses), but an integer tag is stored to discriminate between the objects. | IntegerTag -// FLATTEN_SINGLE_NON_NULLARY_AND_ALWAYS_USE_TAGS looks like a useful representation -// optimization - it trades an extra integer tag in the root type +// A potentially useful additional representation trades an extra integer tag in the root type // for faster discrimination, and in the important single-non-nullary constructor case // // type Tree = Tip | Node of int * Tree * Tree @@ -60,14 +59,15 @@ type UnionReprDecisions<'Union,'Alt,'Type> nullPermitted:'Union->bool, isNullary:'Alt->bool, isList:'Union->bool, + isStruct:'Union->bool, nameOfAlt : 'Alt -> string, makeRootType: 'Union -> 'Type, makeNestedType: 'Union * string -> 'Type) = static let TaggingThresholdFixedConstant = 4 - member repr.OptimizeAllAlternativesToConstantFieldsInRootClass cu = - Array.forall isNullary (getAlternatives cu) + member repr.RepresentAllAlternativesAsConstantFieldsInRootClass cu = + cu |> getAlternatives |> Array.forall isNullary member repr.DiscriminationTechnique cu = if isList cu then @@ -77,18 +77,15 @@ type UnionReprDecisions<'Union,'Alt,'Type> if alts.Length = 1 then SingleCase elif -#if FLATTEN_SINGLE_NON_NULLARY_AND_ALWAYS_USE_TAGS - nullPermitted cu then -#else + not (isStruct cu) && alts.Length < TaggingThresholdFixedConstant && - not (repr.OptimizeAllAlternativesToConstantFieldsInRootClass cu) then -#endif + not (repr.RepresentAllAlternativesAsConstantFieldsInRootClass cu) then RuntimeTypes else IntegerTag // WARNING: this must match IsUnionTypeWithNullAsTrueValue in the F# compiler - member repr.OptimizeAlternativeToNull (cu,alt) = + member repr.RepresentAlternativeAsNull (cu,alt) = let alts = getAlternatives cu nullPermitted cu && (repr.DiscriminationTechnique cu = RuntimeTypes) && (* don't use null for tags, lists or single-case *) @@ -96,54 +93,52 @@ type UnionReprDecisions<'Union,'Alt,'Type> Array.exists (isNullary >> not) alts && isNullary alt (* is this the one? *) - member repr.OptimizingOneAlternativeToNull cu = + member repr.RepresentOneAlternativeAsNull cu = let alts = getAlternatives cu nullPermitted cu && - alts |> Array.existsOne (fun alt -> repr.OptimizeAlternativeToNull (cu,alt)) + alts |> Array.existsOne (fun alt -> repr.RepresentAlternativeAsNull (cu,alt)) - member repr.OptimizeSingleNonNullaryAlternativeToRootClassAndAnyOtherAlternativesToNull (cu,alt) = + member repr.RepresentSingleNonNullaryAlternativeAsInstancesOfRootClassAndAnyOtherAlternativesAsNull (cu,alt) = // Check all nullary constructors are being represented without using sub-classes let alts = getAlternatives cu + not (isStruct cu) && not (isNullary alt) && - (alts |> Array.forall (fun alt2 -> not (isNullary alt2) || repr.OptimizeAlternativeToNull (cu,alt2))) && + (alts |> Array.forall (fun alt2 -> not (isNullary alt2) || repr.RepresentAlternativeAsNull (cu,alt2))) && // Check this is the one and only non-nullary constructor Array.existsOne (isNullary >> not) alts -#if FLATTEN_SINGLE_NON_NULLARY_AND_ALWAYS_USE_TAGS - member repr.OptimizeSingleNonNullaryAlternativeToRootClassAndOtherAlternativesToTagged (cu,alt) = - let alts = getAlternatives cu - not (isNullary alt) && - alts.Length > 1 && - Array.existsOne (isNullary >> not) alts && - not (nullPermitted cu) -#endif - - member repr.OptimizeSingleNonNullaryAlternativeToRootClass (cu,alt) = + member repr.RepresentAlternativeAsFreshInstancesOfRootClass (cu,alt) = + // Flattening + isStruct cu || // Check all nullary constructors are being represented without using sub-classes (isList cu && nameOfAlt alt = ALT_NAME_CONS) || - repr.OptimizeSingleNonNullaryAlternativeToRootClassAndAnyOtherAlternativesToNull (cu, alt) -#if FLATTEN_SINGLE_NON_NULLARY_AND_ALWAYS_USE_TAGS - repr.OptimizeSingleNonNullaryAlternativeToRootClassAndOtherAlternativesToTagged (cu,alt) -#endif + repr.RepresentSingleNonNullaryAlternativeAsInstancesOfRootClassAndAnyOtherAlternativesAsNull (cu, alt) - member repr.OptimizeAlternativeToConstantFieldInTaggedRootClass (cu,alt) = + member repr.RepresentAlternativeAsConstantFieldInTaggedRootClass (cu,alt) = + not (isStruct cu) && isNullary alt && - not (repr.OptimizeAlternativeToNull (cu,alt)) && + not (repr.RepresentAlternativeAsNull (cu,alt)) && (repr.DiscriminationTechnique cu <> RuntimeTypes) + member repr.Flatten cu = + isStruct cu + member repr.OptimizeAlternativeToRootClass (cu,alt) = // The list type always collapses to the root class isList cu || - repr.OptimizeAllAlternativesToConstantFieldsInRootClass cu || - repr.OptimizeAlternativeToConstantFieldInTaggedRootClass (cu,alt) || - repr.OptimizeSingleNonNullaryAlternativeToRootClass(cu,alt) + // Structs are always flattened + repr.Flatten cu || + repr.RepresentAllAlternativesAsConstantFieldsInRootClass cu || + repr.RepresentAlternativeAsConstantFieldInTaggedRootClass (cu,alt) || + repr.RepresentAlternativeAsFreshInstancesOfRootClass(cu,alt) member repr.MaintainPossiblyUniqueConstantFieldForAlternative(cu,alt) = - not (repr.OptimizeAlternativeToNull (cu,alt)) && + not (isStruct cu) && + not (repr.RepresentAlternativeAsNull (cu,alt)) && isNullary alt member repr.TypeForAlternative (cuspec,alt) = - if repr.OptimizeAlternativeToRootClass (cuspec,alt) || repr.OptimizeAlternativeToNull (cuspec,alt) then + if repr.OptimizeAlternativeToRootClass (cuspec,alt) || repr.RepresentAlternativeAsNull (cuspec,alt) then makeRootType cuspec else let altName = nameOfAlt alt @@ -153,7 +148,7 @@ type UnionReprDecisions<'Union,'Alt,'Type> let baseTyOfUnionSpec (cuspec : IlxUnionSpec) = - mkILBoxedTyRaw cuspec.TypeRef cuspec.GenericArgs + mkILNamedTyRaw cuspec.Boxity cuspec.TypeRef cuspec.GenericArgs let mkMakerName (cuspec: IlxUnionSpec) nm = match cuspec.HasHelpers with @@ -170,9 +165,10 @@ let cuspecRepr = (fun (cuspec:IlxUnionSpec) -> cuspec.IsNullPermitted), (fun (alt:IlxUnionAlternative) -> alt.IsNullary), (fun cuspec -> cuspec.HasHelpers = IlxUnionHasHelpers.SpecialFSharpListHelpers), + (fun cuspec -> cuspec.Boxity = ILBoxity.AsValue), (fun (alt:IlxUnionAlternative) -> alt.Name), - (fun cuspec -> mkILBoxedTyRaw cuspec.TypeRef cuspec.GenericArgs), - (fun (cuspec,nm) -> mkILBoxedTyRaw (mkILTyRefInTyRef (mkCasesTypeRef cuspec, nm)) cuspec.GenericArgs)) + (fun cuspec -> cuspec.EnclosingType), + (fun (cuspec,nm) -> mkILNamedTyRaw cuspec.Boxity (mkILTyRefInTyRef (mkCasesTypeRef cuspec, nm)) cuspec.GenericArgs)) type NoTypesGeneratedViaThisReprDecider = NoTypesGeneratedViaThisReprDecider let cudefRepr = @@ -181,6 +177,7 @@ let cudefRepr = (fun (_td,cud) -> cud.cudNullPermitted), (fun (alt:IlxUnionAlternative) -> alt.IsNullary), (fun (_td,cud) -> cud.cudHasHelpers = IlxUnionHasHelpers.SpecialFSharpListHelpers), + (fun (td,_cud) -> match td.tdKind with ILTypeDefKind.ValueType -> true | _ -> false), (fun (alt:IlxUnionAlternative) -> alt.Name), (fun (_td,_cud) -> NoTypesGeneratedViaThisReprDecider), (fun ((_td,_cud),_nm) -> NoTypesGeneratedViaThisReprDecider)) @@ -198,7 +195,7 @@ let refToFieldInTy ty (nm, fldTy) = mkILFieldSpecInTy (ty, nm, fldTy) let formalTypeArgs (baseTy:ILType) = ILList.mapi (fun i _ -> mkILTyvarTy (uint16 i)) baseTy.GenericArgs let constFieldName nm = "_unique_" + nm let constFormalFieldTy (baseTy:ILType) = - ILType.Boxed (mkILTySpecRaw (baseTy.TypeRef, formalTypeArgs baseTy)) + mkILNamedTyRaw baseTy.Boxity baseTy.TypeRef (formalTypeArgs baseTy) let mkConstFieldSpecFromId (baseTy:ILType) constFieldId = refToFieldInTy baseTy constFieldId @@ -265,13 +262,22 @@ let mkLdData (avoidHelpers, cuspec, cidx, fidx) = else [ mkNormalCall (mkILNonGenericInstanceMethSpecInTy(altTy,"get_" + adjustFieldName cuspec.HasHelpers fieldDef.Name,[],fieldDef.Type)) ] +let mkLdDataAddr (avoidHelpers, cuspec, cidx, fidx) = + let alt = altOfUnionSpec cuspec cidx + let altTy = tyForAlt cuspec alt + let fieldDef = alt.FieldDef fidx + if avoidHelpers then + [ mkNormalLdflda (mkILFieldSpecInTy(altTy,fieldDef.LowerName, fieldDef.Type)) ] + else + failwith (sprintf "can't load address using helpers, for fieldDef %s" fieldDef.LowerName) + let mkGetTailOrNull avoidHelpers cuspec = mkLdData (avoidHelpers, cuspec, 1, 1) (* tail is in alternative 1, field number 1 *) let mkGetTagFromHelpers ilg (cuspec: IlxUnionSpec) = let baseTy = baseTyOfUnionSpec cuspec - if cuspecRepr.OptimizingOneAlternativeToNull cuspec then + if cuspecRepr.RepresentOneAlternativeAsNull cuspec then mkNormalCall (mkILNonGenericStaticMethSpecInTy (baseTy, "Get" + tagPropertyName, [baseTy], mkTagFieldFormalType ilg cuspec)) else mkNormalCall (mkILNonGenericInstanceMethSpecInTy(baseTy, "get_" + tagPropertyName, [], mkTagFieldFormalType ilg cuspec)) @@ -289,32 +295,29 @@ let mkCeqThen after = let mkTagDiscriminate ilg cuspec _baseTy cidx = - mkGetTag ilg cuspec - @ [ mkLdcInt32 cidx - AI_ceq ] + mkGetTag ilg cuspec @ [ mkLdcInt32 cidx; AI_ceq ] let mkTagDiscriminateThen ilg cuspec cidx after = - mkGetTag ilg cuspec - @ [ mkLdcInt32 cidx ] - @ mkCeqThen after + mkGetTag ilg cuspec @ [ mkLdcInt32 cidx ] @ mkCeqThen after let convNewDataInstrInternal ilg cuspec cidx = let alt = altOfUnionSpec cuspec cidx let altTy = tyForAlt cuspec alt let altName = alt.Name - if cuspecRepr.OptimizeAlternativeToNull (cuspec,alt) then + if cuspecRepr.RepresentAlternativeAsNull (cuspec,alt) then [ AI_ldnull ] elif cuspecRepr.MaintainPossiblyUniqueConstantFieldForAlternative (cuspec,alt) then let baseTy = baseTyOfUnionSpec cuspec [ I_ldsfld (Nonvolatile,mkConstFieldSpec altName baseTy) ] - elif cuspecRepr.OptimizeSingleNonNullaryAlternativeToRootClass (cuspec,alt) then + elif cuspecRepr.RepresentAlternativeAsFreshInstancesOfRootClass (cuspec,alt) then let baseTy = baseTyOfUnionSpec cuspec let instrs, tagfields = match cuspecRepr.DiscriminationTechnique cuspec with | IntegerTag -> [ mkLdcInt32 cidx ], [mkTagFieldType ilg cuspec] | _ -> [], [] - instrs @ [ mkNormalNewobj(mkILCtorMethSpecForTy (baseTy,(Array.toList alt.FieldTypes @ tagfields))) ] + let ctorFieldTys = alt.FieldTypes |> Array.toList + instrs @ [ mkNormalNewobj(mkILCtorMethSpecForTy (baseTy,(ctorFieldTys @ tagfields))) ] else [ mkNormalNewobj(mkILCtorMethSpecForTy (altTy,Array.toList alt.FieldTypes)) ] @@ -334,7 +337,7 @@ let mkNewData ilg (cuspec, cidx) = | AllHelpers | SpecialFSharpListHelpers | SpecialFSharpOptionHelpers -> - if cuspecRepr.OptimizeAlternativeToNull (cuspec,alt) then + if cuspecRepr.RepresentAlternativeAsNull (cuspec,alt) then [ AI_ldnull ] elif alt.IsNullary then [ mkNormalCall (mkILNonGenericStaticMethSpecInTy (baseTy, "get_" + altName, [], constFormalFieldTy baseTy)) ] @@ -353,9 +356,9 @@ let mkIsData ilg (avoidHelpers, cuspec, cidx) = let alt = altOfUnionSpec cuspec cidx let altTy = tyForAlt cuspec alt let altName = alt.Name - if cuspecRepr.OptimizeAlternativeToNull (cuspec,alt) then + if cuspecRepr.RepresentAlternativeAsNull (cuspec,alt) then [ AI_ldnull; AI_ceq ] - elif cuspecRepr.OptimizeSingleNonNullaryAlternativeToRootClassAndAnyOtherAlternativesToNull (cuspec,alt) then + elif cuspecRepr.RepresentSingleNonNullaryAlternativeAsInstancesOfRootClassAndAnyOtherAlternativesAsNull (cuspec,alt) then // in this case we can use a null test [ AI_ldnull; AI_cgt_un ] else @@ -377,7 +380,6 @@ type ICodeGen<'Mark> = abstract EmitInstr : ILInstr -> unit abstract EmitInstrs : ILInstr list -> unit -// TODO: this will be removed let genWith g : ILCode = let instrs = ResizeArray() let lab2pc = Dictionary() @@ -399,9 +401,9 @@ let mkBrIsNotData ilg (avoidHelpers, cuspec,cidx,tg) = let alt = altOfUnionSpec cuspec cidx let altTy = tyForAlt cuspec alt let altName = alt.Name - if cuspecRepr.OptimizeAlternativeToNull (cuspec,alt) then + if cuspecRepr.RepresentAlternativeAsNull (cuspec,alt) then [ I_brcmp (BI_brtrue,tg) ] - elif cuspecRepr.OptimizeSingleNonNullaryAlternativeToRootClassAndAnyOtherAlternativesToNull (cuspec,alt) then + elif cuspecRepr.RepresentSingleNonNullaryAlternativeAsInstancesOfRootClassAndAnyOtherAlternativesAsNull (cuspec,alt) then // in this case we can use a null test [ I_brcmp (BI_brfalse,tg) ] else @@ -454,10 +456,10 @@ let emitLdDataTagPrim ilg ldOpt (cg: ICodeGen<'Mark>) (avoidHelpers,cuspec: IlxU let alt = altOfUnionSpec cuspec cidx let internalLab = cg.GenerateDelayMark() let failLab = cg.GenerateDelayMark () - let cmpNull = cuspecRepr.OptimizeAlternativeToNull (cuspec, alt) + let cmpNull = cuspecRepr.RepresentAlternativeAsNull (cuspec, alt) let test = I_brcmp ((if cmpNull then BI_brtrue else BI_brfalse),cg.CodeLabel failLab) let testBlock = - if cmpNull || cuspecRepr.OptimizeSingleNonNullaryAlternativeToRootClass (cuspec,alt) then + if cmpNull || cuspecRepr.RepresentAlternativeAsFreshInstancesOfRootClass (cuspec,alt) then [ test ] else let altName = alt.Name @@ -479,9 +481,9 @@ let emitLdDataTagPrim ilg ldOpt (cg: ICodeGen<'Mark>) (avoidHelpers,cuspec: IlxU let emitLdDataTag ilg (cg: ICodeGen<'Mark>) (avoidHelpers,cuspec: IlxUnionSpec) = emitLdDataTagPrim ilg None cg (avoidHelpers,cuspec) -let emitCastData ilg (cg: ICodeGen<'Mark>) (canfail,cuspec,cidx) = +let emitCastData ilg (cg: ICodeGen<'Mark>) (canfail,avoidHelpers,cuspec,cidx) = let alt = altOfUnionSpec cuspec cidx - if cuspecRepr.OptimizeAlternativeToNull (cuspec,alt) then + if cuspecRepr.RepresentAlternativeAsNull (cuspec,alt) then if canfail then let outlab = cg.GenerateDelayMark () let internal1 = cg.GenerateDelayMark () @@ -489,7 +491,22 @@ let emitCastData ilg (cg: ICodeGen<'Mark>) (canfail,cuspec,cidx) = cg.SetMarkToHere internal1 cg.EmitInstrs [mkPrimaryAssemblyExnNewobj ilg "System.InvalidCastException"; I_throw ] cg.SetMarkToHere outlab - // If it can't fail, it's still verifiable just to leave the value on the stack unchecked + else + // If it can't fail, it's still verifiable just to leave the value on the stack unchecked + () + elif cuspecRepr.Flatten cuspec then + if canfail then + let outlab = cg.GenerateDelayMark () + let internal1 = cg.GenerateDelayMark () + cg.EmitInstrs [ AI_dup ] + emitLdDataTagPrim ilg None cg (avoidHelpers,cuspec) + cg.EmitInstrs [ mkLdcInt32 cidx; I_brcmp (BI_beq, cg.CodeLabel outlab) ] + cg.SetMarkToHere internal1 + cg.EmitInstrs [mkPrimaryAssemblyExnNewobj ilg "System.InvalidCastException"; I_throw ] + cg.SetMarkToHere outlab + else + // If it can't fail, it's still verifiable just to leave the value on the stack unchecked + () elif cuspecRepr.OptimizeAlternativeToRootClass (cuspec,alt) then () else @@ -510,11 +527,11 @@ let emitDataSwitch ilg (cg: ICodeGen<'Mark>) (avoidHelpers, cuspec, cases) = let altTy = tyForAlt cuspec alt let altName = alt.Name let failLab = cg.GenerateDelayMark () - let cmpNull = cuspecRepr.OptimizeAlternativeToNull (cuspec,alt) + let cmpNull = cuspecRepr.RepresentAlternativeAsNull (cuspec,alt) cg.EmitInstr (mkLdloc locn) let testInstr = I_brcmp ((if cmpNull then BI_brfalse else BI_brtrue),tg) - if cmpNull || cuspecRepr.OptimizeSingleNonNullaryAlternativeToRootClass (cuspec,alt) then + if cmpNull || cuspecRepr.RepresentAlternativeAsFreshInstancesOfRootClass (cuspec,alt) then cg.EmitInstr testInstr else cg.EmitInstrs (mkRuntimeTypeDiscriminateThen ilg avoidHelpers cuspec alt altName altTy testInstr) @@ -644,7 +661,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a let baseTesterMeths, baseTesterProps = if cud.cudAlternatives.Length <= 1 then [], [] - elif repr.OptimizingOneAlternativeToNull info then [], [] + elif repr.RepresentOneAlternativeAsNull info then [], [] else [ mkILNonGenericInstanceMethod ("get_" + mkTesterName altName, @@ -719,8 +736,8 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a [], [] let typeDefs, altDebugTypeDefs, altNullaryFields = - if repr.OptimizeAlternativeToNull (info,alt) then [], [], [] - elif repr.OptimizeSingleNonNullaryAlternativeToRootClass (info,alt) then [], [], [] + if repr.RepresentAlternativeAsNull (info,alt) then [], [], [] + elif repr.RepresentAlternativeAsFreshInstancesOfRootClass (info,alt) then [], [], [] else let altNullaryFields = if repr.MaintainPossiblyUniqueConstantFieldForAlternative(info,alt) then @@ -770,7 +787,8 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a mkMethodBody(true,emptyILLocals,2, nonBranchingInstrsToCode [ mkLdarg0 - mkNormalLdfld (mkILFieldSpecInTy (debugProxyTy,debugProxyFieldName,altTy)) + (match td.tdKind with ILTypeDefKind.ValueType -> mkNormalLdflda | _ -> mkNormalLdfld) + (mkILFieldSpecInTy (debugProxyTy,debugProxyFieldName,altTy)) mkNormalLdfld (mkILFieldSpecInTy(altTy,fldName,fldTy))],None)) |> addMethodGeneratedAttrs ilg) |> Array.toList @@ -863,8 +881,9 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a let mkClassUnionDef ilg tref td cud = - let baseTy = mkILFormalBoxedTy tref td.GenericParams - let cuspec = IlxUnionSpec(IlxUnionRef(baseTy.TypeRef, cud.cudAlternatives, cud.cudNullPermitted, cud.cudHasHelpers), baseTy.GenericArgs) + let boxity = match td.tdKind with ILTypeDefKind.ValueType -> ILBoxity.AsValue | _ -> ILBoxity.AsObject + let baseTy = mkILFormalNamedTy boxity tref td.GenericParams + let cuspec = IlxUnionSpec(IlxUnionRef(boxity,baseTy.TypeRef, cud.cudAlternatives, cud.cudNullPermitted, cud.cudHasHelpers), baseTy.GenericArgs) let info = (td,cud) let repr = cudefRepr let isTotallyImmutable = (cud.cudHasHelpers <> SpecialFSharpListHelpers) @@ -886,33 +905,42 @@ let mkClassUnionDef ilg tref td cud = | SingleCase | RuntimeTypes | TailOrNull -> [] | IntegerTag -> [ mkTagFieldId ilg cuspec ] - let selfFields, selfMeths, selfProps, _ = - match cud.cudAlternatives |> Array.toList |> List.findi 0 (fun alt -> repr.OptimizeSingleNonNullaryAlternativeToRootClass (info,alt)) with - | Some (alt,altNum) -> - let fields = (alt.FieldDefs |> Array.toList |> List.map mkUnionCaseFieldId) + let isStruct = match td.tdKind with ILTypeDefKind.ValueType -> true | _ -> false + + let selfFields, selfMeths, selfProps = + + [ for alt in cud.cudAlternatives do + if repr.RepresentAlternativeAsFreshInstancesOfRootClass (info,alt) then + // TODO + let fields = alt.FieldDefs |> Array.toList |> List.map mkUnionCaseFieldId + let baseInit = + if isStruct then None else + match td.Extends with + | None -> Some ilg.tspec_Object + | Some typ -> Some typ.TypeSpec + let ctor = mkILSimpleStorageCtor (cud.cudWhere, - (match td.Extends with None -> Some ilg.tspec_Object | Some typ -> Some typ.TypeSpec), + baseInit, baseTy, (fields @ tagFieldsInObject), (if cuspec.HasHelpers = AllHelpers then ILMemberAccess.Assembly else cud.cudReprAccess)) |> addMethodGeneratedAttrs ilg let props, meths = mkMethodsAndPropertiesForFields ilg cud.cudReprAccess cud.cudWhere cud.cudHasHelpers baseTy alt.FieldDefs - fields,([ctor] @ meths),props,altNum - - | None -> - [],[],[],0 + yield (fields,([ctor] @ meths),props) ] + |> List.unzip3 + |> (fun (a,b,c) -> List.concat a, List.concat b, List.concat c) let selfAndTagFields = [ for (fldName,fldTy) in (selfFields @ tagFieldsInObject) do let fdef = mkHiddenGeneratedInstanceFieldDef ilg (fldName,fldTy, None, ILMemberAccess.Assembly) - yield { fdef with IsInitOnly=isTotallyImmutable } ] + yield { fdef with IsInitOnly= (not isStruct && isTotallyImmutable) } ] let ctorMeths = if (isNil selfFields && isNil tagFieldsInObject && nonNil selfMeths) - || cud.cudAlternatives |> Array.forall (fun alt -> repr.OptimizeSingleNonNullaryAlternativeToRootClass (info,alt)) then + || cud.cudAlternatives |> Array.forall (fun alt -> repr.RepresentAlternativeAsFreshInstancesOfRootClass (info,alt)) then [] (* no need for a second ctor in these cases *) @@ -962,7 +990,7 @@ let mkClassUnionDef ilg tref td cud = let body = mkMethodBody(true,emptyILLocals,2,genWith (fun cg -> emitLdDataTagPrim ilg (Some mkLdarg0) cg (true, cuspec); cg.EmitInstr I_ret), cud.cudWhere) // // If we are using NULL as a representation for an element of this type then we cannot // // use an instance method - if (repr.OptimizingOneAlternativeToNull info) then + if (repr.RepresentOneAlternativeAsNull info) then [ mkILNonGenericStaticMethod("Get" + tagPropertyName,cud.cudHelpersAccess,[mkILParamAnon baseTy],mkILReturn tagFieldType,body) |> addMethodGeneratedAttrs ilg ], [] @@ -1024,28 +1052,16 @@ let mkClassUnionDef ilg tref td cud = tdKind = ILTypeDefKind.Enum } let baseTypeDef = - { Name = td.Name + { td with NestedTypes = mkILTypeDefs (Option.toList enumTypeDef @ altTypeDefs @ altDebugTypeDefs @ td.NestedTypes.AsList) - GenericParams= td.GenericParams - Access = td.Access IsAbstract = isAbstract IsSealed = altTypeDefs.IsEmpty - IsSerializable=td.IsSerializable IsComInterop=false - Layout=td.Layout - IsSpecialName=td.IsSpecialName - Encoding=td.Encoding - Implements = td.Implements Extends= (match td.Extends with None -> Some ilg.typ_Object | _ -> td.Extends) Methods= mkILMethods (ctorMeths @ baseMethsFromAlt @ selfMeths @ tagMeths @ altUniqObjMeths @ existingMeths) - SecurityDecls=td.SecurityDecls - HasSecurity=td.HasSecurity Fields=mkILFields (selfAndTagFields @ List.map (fun (_,_,_,_,fdef,_) -> fdef) altNullaryFields @ td.Fields.AsList) - MethodImpls=td.MethodImpls InitSemantics=ILTypeInit.BeforeField - Events=td.Events Properties=mkILProperties (tagProps @ basePropsFromAlt @ selfProps @ existingProps) - CustomAttrs=td.CustomAttrs tdKind = ILTypeDefKind.Class } // The .cctor goes on the Cases type since that's where the constant fields for nullary constructors live |> addConstFieldInit diff --git a/src/ilx/EraseUnions.fsi b/src/ilx/EraseUnions.fsi index 09d5e41e29d..47311b27700 100644 --- a/src/ilx/EraseUnions.fsi +++ b/src/ilx/EraseUnions.fsi @@ -9,19 +9,22 @@ module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseUnions open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types -/// Make the instruction sequence for an ILX "newdata" instruction +/// Make the instruction sequence for a "newdata" operation val mkNewData : ILGlobals -> IlxUnionSpec * int -> ILInstr list -/// Make the instruction sequence for an ILX "isdata" instruction +/// Make the instruction sequence for a "isdata" operation val mkIsData : ILGlobals -> bool * IlxUnionSpec * int -> ILInstr list -/// Make the instruction sequence for an ILX "lddata" instruction +/// Make the instruction sequence for a "lddata" operation val mkLdData : bool * IlxUnionSpec * int * int -> ILInstr list -/// Make the instruction sequence for an ILX "stdata" instruction +/// Make the instruction sequence for a "lddataa" operation +val mkLdDataAddr : bool * IlxUnionSpec * int * int -> ILInstr list + +/// Make the instruction sequence for a "stdata" operation val mkStData : IlxUnionSpec * int * int -> ILInstr list -/// Make the instruction sequence for an ILX "brisnotdata" instruction +/// Make the instruction sequence for a "brisnotdata" operation val mkBrIsNotData : ILGlobals -> avoidHelpers:bool * IlxUnionSpec * int * ILCodeLabel -> ILInstr list /// Make the type definition for a union type @@ -39,11 +42,11 @@ type ICodeGen<'Mark> = abstract EmitInstr : ILInstr -> unit abstract EmitInstrs : ILInstr list -> unit -/// Emit the instruction sequence for an ILX "castdata" instruction -val emitCastData : ILGlobals -> ICodeGen<'Mark> -> canfail: bool * IlxUnionSpec * int -> unit +/// Emit the instruction sequence for a "castdata" operation +val emitCastData : ILGlobals -> ICodeGen<'Mark> -> canfail: bool * avoidHelpers:bool * IlxUnionSpec * int -> unit -/// Emit the instruction sequence for an ILX "lddatatag" instruction +/// Emit the instruction sequence for a "lddatatag" operation val emitLdDataTag : ILGlobals -> ICodeGen<'Mark> -> avoidHelpers:bool * IlxUnionSpec -> unit -/// Emit the instruction sequence for an ILX "switchdata" instruction +/// Emit the instruction sequence for a "switchdata" operation val emitDataSwitch : ILGlobals -> ICodeGen<'Mark> -> avoidHelpers:bool * IlxUnionSpec * (int * ILCodeLabel) list -> unit diff --git a/src/utils/CompilerLocationUtils.fs b/src/utils/CompilerLocationUtils.fs index f607293cfb5..85efb2e5735 100644 --- a/src/utils/CompilerLocationUtils.fs +++ b/src/utils/CompilerLocationUtils.fs @@ -12,15 +12,7 @@ open System.Runtime.InteropServices module internal FSharpEnvironment = /// The F# version reported in the banner -#if OPEN_BUILD - let DotNetBuildString = "(private)" -#else - /// The .NET runtime version that F# was built against (e.g. "v4.0.21104") - let DotNetRuntime = sprintf "v%s.%s.%s" Microsoft.BuildSettings.Version.Major Microsoft.BuildSettings.Version.Minor Microsoft.BuildSettings.Version.ProductBuild - - /// The .NET build string that F# was built against (e.g. "4.0.21104.0") - let DotNetBuildString = Microsoft.BuildSettings.Version.OfFile -#endif + let FSharpBannerVersion = "4.1" let versionOf<'t> = #if FX_RESHAPED_REFLECTION diff --git a/tests/BuildTestTools.cmd b/tests/BuildTestTools.cmd index 9c220651c84..839be2c6275 100644 --- a/tests/BuildTestTools.cmd +++ b/tests/BuildTestTools.cmd @@ -69,20 +69,20 @@ if '%BUILD_CORECLR%' == '1' ( ) rem deploy x86 version of compiler and dependencies - %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.5/win7-x86 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\fsc\win7-x86 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:yes --v:quiet - %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.5/win7-x86 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\win7-x86 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:no --v:quiet + %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.6/win7-x86 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\fsc\win7-x86 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:yes --v:quiet + %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.6/win7-x86 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\win7-x86 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:no --v:quiet rem deploy x64 version of compiler - %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.5/win7-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\fsc\win7-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:yes --v:quiet - %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.5/win7-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\win7-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:no --v:quiet + %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.6/win7-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\fsc\win7-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:yes --v:quiet + %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.6/win7-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\win7-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:no --v:quiet rem deploy linux version of built compiler - %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.5/ubuntu.14.04-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\fsc\ubuntu.14.04-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:yes --v:quiet - %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.5/ubuntu.14.04-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\ubuntu.14.04-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:no --v:quiet + %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.6/ubuntu.14.04-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\fsc\ubuntu.14.04-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:yes --v:quiet + %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.6/ubuntu.14.04-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\ubuntu.14.04-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:no --v:quiet rem deploy osx version of built compiler - %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.5/osx.10.10-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\fsc\osx.10.10-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:yes --v:quiet - %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.5/osx.10.10-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\osx.10.10-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:no --v:quiet + %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.6/osx.10.10-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\fsc\osx.10.10-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:yes --v:quiet + %_fsiexe% --exec %~dp0fsharpqa\testenv\src\DeployProj\DeployProj.fsx --targetPlatformName:.NETStandard,Version=v1.6/osx.10.10-x64 --projectJson:%~dp0fsharp\project.json --projectJsonLock:%~dp0fsharp\project.lock.json --packagesDir:%~dp0..\packages --fsharpCore:%~dp0..\%1\coreclr\bin\fsharp.core.dll --output:%~dp0testbin\%1\coreclr\osx.10.10-x64 --nugetPath:%~dp0..\.nuget\nuget.exe --nugetConfig:%~dp0..\.nuget\nuget.config --copyCompiler:no --v:quiet echo "%NUNITPATH%*.*" "%~dp0fsharpqa\testenv\bin\nunit\*.*" /S /Q /Y xcopy "%NUNITPATH%*.*" "%~dp0fsharpqa\testenv\bin\nunit\*.*" /S /Q /Y diff --git a/tests/fsharp/Commands.fs b/tests/fsharp/Commands.fs index 0b39e7af2d8..dd3e03e2b16 100644 --- a/tests/fsharp/Commands.fs +++ b/tests/fsharp/Commands.fs @@ -130,7 +130,7 @@ let convertToShortPath path = match Process.exec cmdArgs (Path.GetTempPath()) Map.empty "cmd.exe" args with | ErrorLevel _ -> path - | Ok -> match !result with None -> path | Some p -> p + | CmdResult.Success -> match !result with None -> path | Some p -> p let where envVars cmd = log "where %s" cmd diff --git a/tests/fsharp/core/attributes/testlib.fs b/tests/fsharp/core/attributes/testlib.fs index e5f00296b2c..eddb622fccc 100644 --- a/tests/fsharp/core/attributes/testlib.fs +++ b/tests/fsharp/core/attributes/testlib.fs @@ -116,3 +116,5 @@ module TypeParamAttributesDifferent = type ThisLibAssembly = X | Y + + diff --git a/tests/fsharp/core/fsfromcs/lib.ml b/tests/fsharp/core/fsfromcs/lib.fs similarity index 99% rename from tests/fsharp/core/fsfromcs/lib.ml rename to tests/fsharp/core/fsfromcs/lib.fs index 4e9936fb13c..1ca7ef43135 100644 --- a/tests/fsharp/core/fsfromcs/lib.ml +++ b/tests/fsharp/core/fsfromcs/lib.fs @@ -1,4 +1,4 @@ - +module Lib (* An F# library which we try to access from C# *) type Recd1 = { recd1field1: int } diff --git a/tests/fsharp/core/fsfromfsviacs/lib.ml b/tests/fsharp/core/fsfromfsviacs/lib.fs similarity index 51% rename from tests/fsharp/core/fsfromfsviacs/lib.ml rename to tests/fsharp/core/fsfromfsviacs/lib.fs index f40253dc634..ceb7bc8fbae 100644 --- a/tests/fsharp/core/fsfromfsviacs/lib.ml +++ b/tests/fsharp/core/fsfromfsviacs/lib.fs @@ -1,4 +1,4 @@ - +module Lib (* An F# library which we use in a C# library, where we in turn use both the F# component and the C# library together from F# *) type recd1 = { recd1field1: int } @@ -44,3 +44,73 @@ let tup4 = (2,3,4,5) + +module StructUnionsTests = + + [] + type U0 = U0 + + let f0 x = match x with U0 -> 1 + + let v0 = f0 U0 + + [] + type U1 = U1 of int + + let f1 x = match x with U1(x) -> x + x + + let v1 = f1 (U1(3)) + + [] + type U2 = U2 of int * int + + let f2 x = match x with U2(x,y) -> x + y + + let v2 = f2 (U2(3,4)) + + [] + type Ok3 = Ok3 of int * Ok3 list + +/// Nesting structs inside struct unions means taking the address of things during pattern matching +module NestedStructUnionsTests = + + [] + type U1 = U1 of System.DateTime * string + + [] + type U2 = U2 of U1 * U1 + + + let testPattern1(u2:U2) = + match u2 with + | U2(u1a,u1b) -> + match u1a, u1b with + | U1(dt1,s1), U1(dt2,s2) -> (dt1 = dt2) && (s1 = "a") && (s2 = "b") + + let testPattern2(u2:U2) = + match u2 with + | U2(U1(dt1,s1),U1(dt2,s2)) -> (dt1 = dt2) && (s1 = "a") && (s2 = "b") + + let testPattern3(u2:U2) = + match u2 with + | U2(U1(dt1,"a"),U1(dt2,"b")) -> (dt1 = dt2) + + + let testPattern1mut(u2:U2) = + let mutable u2 = u2 + match u2 with + | U2(u1a,u1b) -> + match u1a, u1b with + | U1(dt1,s1), U1(dt2,s2) -> (dt1 = dt2) && (s1 = "a") && (s2 = "b") + + let testPattern2mut(u2:U2) = + let mutable u2 = u2 + match u2 with + | U2(U1(dt1,s1),U1(dt2,s2)) -> (dt1 = dt2) && (s1 = "a") && (s2 = "b") + + let testPattern3mut(u2:U2) = + let mutable u2 = u2 + match u2 with + | U2(U1(dt1,"a"),U1(dt2,"b")) -> (dt1 = dt2) + + diff --git a/tests/fsharp/core/fsfromfsviacs/lib2.cs b/tests/fsharp/core/fsfromfsviacs/lib2.cs index c86e38e7ac6..969347a49f7 100644 --- a/tests/fsharp/core/fsfromfsviacs/lib2.cs +++ b/tests/fsharp/core/fsfromfsviacs/lib2.cs @@ -32,6 +32,10 @@ public class Lib2 public static FSharpRef ri1 = new FSharpRef(3); public static FSharpRef rr1 = new FSharpRef(r1); + public static Lib.StructUnionsTests.U0 u0 = Lib.StructUnionsTests.U0.U0; + public static Lib.StructUnionsTests.U1 u1 = Lib.StructUnionsTests.U1.NewU1(3); + public static Lib.StructUnionsTests.U2 u2 = Lib.StructUnionsTests.U2.NewU2(3,4); + static Lib2() { r3.recd3field3 = r3; } } diff --git a/tests/fsharp/core/fsfromfsviacs/test.fsx b/tests/fsharp/core/fsfromfsviacs/test.fsx index 742b0f284a5..2c0f1652a0c 100644 --- a/tests/fsharp/core/fsfromfsviacs/test.fsx +++ b/tests/fsharp/core/fsfromfsviacs/test.fsx @@ -27,7 +27,71 @@ let _ = test "fejio2dw" (Lib2.or1 = Some r1) let _ = test "fejio2dw" (Lib2.ri1 = ref 3) let _ = test "fejio2dw" (Lib2.rr1 = ref r1) +let _ = test "structunion3948" (Lib2.u0 = Lib.StructUnionsTests.U0) +let _ = test "structunion3949" (Lib2.u1 = Lib.StructUnionsTests.U1(3)) +let _ = test "structunion3949" (Lib2.u2 = Lib.StructUnionsTests.U2(3,4)) + +let _ = test "structunion3948" (compare Lib2.u0 Lib.StructUnionsTests.U0 = 0) +let _ = test "structunion3949" (compare Lib2.u1 (Lib.StructUnionsTests.U1(3)) = 0) +let _ = test "structunion394a" (compare Lib2.u1 (Lib.StructUnionsTests.U1(4)) = -1) +let _ = test "structunion394b" (compare Lib2.u1 (Lib.StructUnionsTests.U1(2)) = 1) +let dt = System.DateTime.Now +let u1a = Lib.NestedStructUnionsTests.U1(dt,"a") +let u1b = Lib.NestedStructUnionsTests.U1(dt,"b") +let u2 = Lib.NestedStructUnionsTests.U2(u1a,u1b) +let _ = test "structunion394b11" (Lib.NestedStructUnionsTests.testPattern1(u2)) +let _ = test "structunion394b22" (Lib.NestedStructUnionsTests.testPattern2(u2)) +let _ = test "structunion394b33" (Lib.NestedStructUnionsTests.testPattern3(u2)) +let _ = test "structunion394b14" (Lib.NestedStructUnionsTests.testPattern1mut(u2)) +let _ = test "structunion394b25" (Lib.NestedStructUnionsTests.testPattern2mut(u2)) +let _ = test "structunion394b36" (Lib.NestedStructUnionsTests.testPattern3mut(u2)) + + +module NestedStructPatternMatchingAcrossAssemblyBoundaries = + open Lib.NestedStructUnionsTests + + let testPattern1(u2:U2) = + match u2 with + | U2(u1a,u1b) -> + match u1a, u1b with + | U1(dt1,s1), U1(dt2,s2) -> (dt1 = dt2) && (s1 = "a") && (s2 = "b") + + let testPattern2(u2:U2) = + match u2 with + | U2(U1(dt1,s1),U1(dt2,s2)) -> (dt1 = dt2) + + let testPattern3(u2:U2) = + match u2 with + | U2(U1(dt1,"a"),U1(dt2,"b")) -> (dt1 = dt2) + + let testPattern1mut(u2:U2) = + let mutable u2 = u2 + match u2 with + | U2(u1a,u1b) -> + match u1a, u1b with + | U1(dt1,s1), U1(dt2,s2) -> (dt1 = dt2) && (s1 = "a") && (s2 = "b") + + let testPattern2mut(u2:U2) = + let mutable u2 = u2 + match u2 with + | U2(U1(dt1,s1),U1(dt2,s2)) -> (dt1 = dt2) && (s1 = "a") && (s2 = "b") + + let testPattern3mut(u2:U2) = + let mutable u2 = u2 + match u2 with + | U2(U1(dt1,"a"),U1(dt2,"b")) -> (dt1 = dt2) + + + let _ = test "structunion394b1a" (testPattern1(u2)) + let _ = test "structunion394b2b" (testPattern2(u2)) + let _ = test "structunion394b3c" (testPattern3(u2)) + + let _ = test "structunion394b1d" (testPattern1mut(u2)) + let _ = test "structunion394b2e" (testPattern2mut(u2)) + let _ = test "structunion394b3f" (testPattern3mut(u2)) + + (* public Lib.discr1_0 d10a = Lib.discr1_0.MkDiscr1_0_A(); public Lib.discr1_1 d11a = Lib.discr1_1.MkDiscr1_1_A(3); diff --git a/tests/fsharp/core/fsiAndModifiers/test.fsx b/tests/fsharp/core/fsiAndModifiers/test.fsx index 39acf7397aa..16b3d33aee0 100644 --- a/tests/fsharp/core/fsiAndModifiers/test.fsx +++ b/tests/fsharp/core/fsiAndModifiers/test.fsx @@ -86,6 +86,57 @@ module TestPack4 = printfn "got %A" got if got <> expected then fail (sprintf "TestPack4: got %A, expected %A" got expected) +module PinTests = + open FSharp.NativeInterop + // Assume that the following class exists. + + type Point = { mutable x : int; mutable y : int } + + let pinObject() = + let point = { x = 1; y = 2 } + use p1 = fixed &point.x // note, fixed is a keyword and would be highlighted + NativePtr.get p1 0 + NativePtr.get p1 1 + + let pinRef() = + let point = ref 17 + use p1 = fixed &point.contents // note, fixed is a keyword and would be highlighted + NativePtr.read p1 + NativePtr.read p1 + + let pinArray1() = + let arr = [| 0.0; 1.5; 2.3; 3.4; 4.0; 5.9 |] + use p1 = fixed arr + NativePtr.get p1 0 + NativePtr.get p1 1 + + let pinArray2() = + let arr = [| 0.0; 1.5; 2.3; 3.4; 4.0; 5.9 |] + // You can initialize a pointer by using the address of a variable. + use p = fixed &arr.[0] + NativePtr.get p 0 + NativePtr.get p 1 + + let pinNullArray() = + let arr : int[] = null + use p1 = fixed arr + 4 + + let pinEmptyArray() = + let arr : int[] = [| |] + use p1 = fixed arr + 76 + + let pinString() = + let str = "Hello World" + // The following assignment initializes p by using a string. + use pChar = fixed str + NativePtr.get pChar 0, NativePtr.get pChar 1 + + if pinObject() <> 3 then fail "FAILED: pinObject" + if pinRef() <> 34 then fail "FAILED: pinObject" + if pinArray1() <> 1.5 then fail "FAILED: pinArray1" + if pinArray2() <> 1.5 then fail "FAILED: pinArray2" + if pinNullArray() <> 4 then fail "FAILED: pinNullArray" + if pinEmptyArray() <> 76 then fail "FAILED: pinEmptyArray" + if pinString() <> ('H', 'e') then fail "FAILED: pinString" + if errors.IsEmpty then System.IO.File.WriteAllText("test.ok", "") diff --git a/tests/fsharp/core/internalsvisible/librarycs.cs b/tests/fsharp/core/internalsvisible/librarycs.cs index 8b2c3eaaac4..f985db4f4ca 100644 --- a/tests/fsharp/core/internalsvisible/librarycs.cs +++ b/tests/fsharp/core/internalsvisible/librarycs.cs @@ -15,5 +15,17 @@ internal class APrivateClass { private static int PrivateProperty { get { return 2; } } internal static int InternalProperty { get { return 2; } } - } + } + public class Class1 + { + public Class1() { } + protected static int ProtectedStatic; + internal static int InternalStatic; + protected internal static int ProtectedInternalStatic; + public static int PublicStatic; + protected int Protected; + internal int Internal; + protected internal int ProtectedInternal; + public int Public; + } } diff --git a/tests/fsharp/core/internalsvisible/main.fs b/tests/fsharp/core/internalsvisible/main.fs index fbe6256ad27..7c8119827b7 100644 --- a/tests/fsharp/core/internalsvisible/main.fs +++ b/tests/fsharp/core/internalsvisible/main.fs @@ -18,6 +18,24 @@ printf "APrivateClass.InternalProperty = %2d\n" LibraryCS.APrivateClass.Inter //printf "privateF 2 = %d\n" (Library.M.privateF 2) // inaccessable +module internal Repro1332 = + let c = LibraryCS.Class1() + //c.Protected |> ignore + c.Internal |> ignore + c.ProtectedInternal |> ignore + LibraryCS.Class1.InternalStatic |> ignore + LibraryCS.Class1.ProtectedInternalStatic |> ignore + +type internal Class2() = + inherit LibraryCS.Class1() + member c.M() = + c.Internal |> ignore + c.ProtectedInternal |> ignore + c.Protected |> ignore + LibraryCS.Class1.InternalStatic |> ignore + LibraryCS.Class1.ProtectedInternalStatic |> ignore + LibraryCS.Class1.ProtectedStatic |> ignore + (* Check that internalVisibleTo items can be used in internal items *) module internal Repro3737 = diff --git a/tests/fsharp/core/longnames/test.fsx b/tests/fsharp/core/longnames/test.fsx index e4b1b879e6f..2035466fc8b 100644 --- a/tests/fsharp/core/longnames/test.fsx +++ b/tests/fsharp/core/longnames/test.fsx @@ -413,6 +413,214 @@ module TestsForUsingTypeNamesAsValuesWhenTheTypeHasAConstructor = begin end +module Ok1 = + + module A = + let create() = 1 + type Dummy = A | B + + + type A() = + member x.P = 1 + + test "lkneecec09iew1" (typeof.FullName.Contains("AModule") ) + + +module Ok2 = + + type A() = + member x.P = 1 + + + module A = + let create() = 1 + type Dummy = A | B + + test "lkneecec09iew2" (typeof.FullName.Contains("AModule") ) + + +module Ok3 = + + [] + module A = + let create() = 1 + type Dummy = A | B + + type A() = + member x.P = 1 + + test "lkneecec09iew3" (typeof.FullName.Contains("AModule") ) + + +module Ok4 = + + type A() = + member x.P = 1 + + [] + module A = + let create() = 1 + type Dummy = A | B + + test "lkneecec09iew4" (typeof.FullName.Contains("AModule") ) + + + +module rec Ok5 = + + module A = + let create() = 1 + type Dummy = A | B + + + type A() = + member x.P = 1 + + test "lkneecec09iew5" (typeof.FullName.Contains("AModule") ) + + +module rec Ok6 = + + type A() = + member x.P = 1 + + + module A = + let create() = 1 + type Dummy = A | B + + test "lkneecec09iew6" (typeof.FullName.Contains("AModule") ) + + +module rec Ok7 = + + [] + module A = + let create() = 1 + type Dummy = A | B + + type A() = + member x.P = 1 + + test "lkneecec09iew7" (typeof.FullName.Contains("AModule") ) + + +module rec Ok8 = + + type A() = + member x.P = 1 + + [] + module A = + let create() = 1 + type Dummy = A | B + + test "lkneecec09iew8" (typeof.FullName.Contains("AModule") ) + + +module Ok9 = + + type A() = + member x.P = 1 + + type A<'T>() = + member x.P = 1 + + module A = + let create() = 1 + type Dummy = A | B + + + test "lkneecec09iew9" (typeof.FullName.Contains("AModule") ) + + +module Ok9b = + + type A<'T>() = + member x.P = 1 + + module A = + let create() = 1 + type Dummy = A | B + + + test "lkneecec09iew9" (typeof.FullName.Contains("AModule") ) + +module rec Ok10 = + + type A() = + member x.P = 1 + + type A<'T>() = + member x.P = 1 + + module A = + let create() = 1 + type Dummy = A | B + + test "lkneecec09iew10" (typeof.FullName.Contains("AModule") ) + +module Ok11 = + + type A = int + + module A = + let create() = 1 + type Dummy = A | B + + test "lkneecec09iew11" (typeof.FullName.Contains("AModule") ) + +module Ok12 = + + type A = A + + module A = + let create() = 1 + type Dummy = A | B + + test "lkneecec09iew12" (typeof.FullName.Contains("AModule") ) + +module Ok13 = + + type A = A of string + + module A = + let create() = 1 + type Dummy = A | B + + test "lkneecec09iew13" (typeof.FullName.Contains("AModule") ) + + +module Ok14 = + + module X = + type A = A of string + + type X.A with + member x.P = 1 + + module A = // the type definition is an augmentation so doesn't get the suffix + let create() = 1 + type Dummy = A | B + + test "lkneecec09iew14" (not (typeof.FullName.Contains("AModule") )) + +module rec Ok15 = + + open X + + module X = + type A = A of string + + type A with + member x.P = 1 + + module A = // the type definition is an augmentation so doesn't get the suffix + let create() = 1 + type Dummy = A | B + + test "lkneecec09iew15" (not (typeof.FullName.Contains("AModule") )) + let aa = if !failures then (stdout.WriteLine "Test Failed"; exit 1) diff --git a/tests/fsharp/core/pinvoke/test.fsx b/tests/fsharp/core/pinvoke/test.fsx index 3d63185df3b..3d8a4831c58 100644 --- a/tests/fsharp/core/pinvoke/test.fsx +++ b/tests/fsharp/core/pinvoke/test.fsx @@ -1,5 +1,5 @@ // #Conformance #Interop #PInvoke #Structs -#light + #nowarn "9" open System @@ -37,12 +37,11 @@ let pinned (obj: obj) f = // (typeof<'a>) == (typeof) or // etc. -type PinBox<'a> = { v : obj } - with +type PinBox<'a> = + { v : obj } static member Create(x) = { v = box(x) } member x.Value = (unbox x.v : 'a) member x.Pin(f) = pinned(x.v) f - end let card_init () = let width = PinBox<_>.Create(300) in @@ -135,7 +134,7 @@ let example1() = -module GetSystemTimeTest = begin +module GetSystemTimeTest = open System open System.Runtime.InteropServices @@ -166,9 +165,8 @@ module GetSystemTimeTest = begin (int32 sysTime.wMinute ) (int32 sysTime.wSecond) -end -module MemoryStatusTest = begin +module MemoryStatusTest = open System open System.Runtime.InteropServices @@ -204,10 +202,9 @@ module MemoryStatusTest = begin printf "%A\n" mex main() -end -module MemoryStatusTest2 = begin +module MemoryStatusTest2 = open System open System.Runtime.InteropServices @@ -243,5 +240,4 @@ module MemoryStatusTest2 = begin printf "%A\n" mex main() -end diff --git a/tests/fsharp/core/quotes/test.fsx b/tests/fsharp/core/quotes/test.fsx index 2c45e996577..2ad7e1386a4 100644 --- a/tests/fsharp/core/quotes/test.fsx +++ b/tests/fsharp/core/quotes/test.fsx @@ -1610,93 +1610,38 @@ module MoreQuotationsTests = let _ = <@@ v2.Int32ExtensionMethod5 @@> |> printfn "quote = %A" -module QuotationConstructionTests = - let arr = [| 1;2;3;4;5 |] - let f : int -> int = printfn "hello"; (fun x -> x) - let f2 : int * int -> int -> int = printfn "hello"; (fun (x,y) z -> x + y + z) - let F (x:int) = x - let F2 (x:int,y:int) (z:int) = x + y + z - - type Foo () = - member t.Item with get (index:int) = 1 - and set (index:int) (value:int) = () - - let ctorof q = match q with Patterns.NewObject(cinfo,_) -> cinfo | _ -> failwith "ctorof" - let methodof q = match q with DerivedPatterns.Lambdas(_,Patterns.Call(_,minfo,_)) -> minfo | _ -> failwith "methodof" - let fieldof q = match q with Patterns.FieldGet(_,finfo) -> finfo | _ -> failwith "fieldof" - let ucaseof q = match q with Patterns.NewUnionCase(ucinfo,_) -> ucinfo | _ -> failwith "ucaseof" - let getof q = match q with Patterns.PropertyGet(_,pinfo,_) -> pinfo | _ -> failwith "getof" - let setof q = match q with Patterns.PropertySet(_,pinfo,_,_) -> pinfo | _ -> failwith "setof" - check "vcknwwe01" (match Expr.AddressOf <@@ arr.[3] @@> with AddressOf(expr) -> expr = <@@ arr.[3] @@> | _ -> false) true - check "vcknwwe02" (match Expr.AddressSet (Expr.AddressOf <@@ arr.[3] @@>, <@@ 4 @@>) with AddressSet(AddressOf(expr),v) -> expr = <@@ arr.[3] @@> && v = <@@ 4 @@> | _ -> false) true - check "vcknwwe03" (match Expr.Application(<@@ f @@>,<@@ 5 @@>) with Application(f1,x) -> f1 = <@@ f @@> && x = <@@ 5 @@> | _ -> false) true - check "vcknwwe04" (match Expr.Applications(<@@ f @@>,[[ <@@ 5 @@> ]]) with Applications(f1,[[x]]) -> f1 = <@@ f @@> && x = <@@ 5 @@> | _ -> false) true - check "vcknwwe05" (match Expr.Applications(<@@ f2 @@>,[[ <@@ 5 @@>;<@@ 6 @@> ]; [ <@@ 7 @@> ]]) with Applications(f1,[[x;y];[z]]) -> f1 = <@@ f2 @@> && x = <@@ 5 @@> && y = <@@ 6 @@> && z = <@@ 7 @@> | _ -> false) true - check "vcknwwe06" (match Expr.Call(methodof <@@ F2 @@>,[ <@@ 5 @@>;<@@ 6 @@>; <@@ 7 @@> ]) with Call(None,minfo,[x;y;z]) -> minfo = methodof <@@ F2 @@> && x = <@@ 5 @@> && y = <@@ 6 @@> && z = <@@ 7 @@> | _ -> false) true - check "vcknwwe07" (Expr.Cast(<@@ 5 @@>) : Expr) (<@ 5 @>) - check "vcknwwe08" (try let _ = Expr.Cast(<@@ 5 @@>) : Expr in false with :? System.ArgumentException -> true) true - check "vcknwwe09" (match Expr.Coerce(<@@ 5 @@>, typeof) with Coerce(q,ty) -> ty = typeof && q = <@@ 5 @@> | _ -> false) true - check "vcknwwe0q" (match Expr.DefaultValue(typeof) with DefaultValue(ty) -> ty = typeof | _ -> false) true - check "vcknwwe0w" (match Expr.FieldGet(typeof.GetField("MaxValue")) with FieldGet(None,finfo) -> finfo = typeof.GetField("MaxValue") | _ -> false) true - check "vcknwwe0e" (match Expr.FieldSet(typeof.GetField("MaxValue"),<@@ 1 @@>) with FieldSet(None,finfo,v) -> finfo = typeof.GetField("MaxValue") && v = <@@ 1 @@> | _ -> false) true - check "vcknwwe0r" (match Expr.ForIntegerRangeLoop(Var.Global("i",typeof),<@@ 1 @@>,<@@ 10 @@>,<@@ () @@>) with ForIntegerRangeLoop(v,start,finish,body) -> v = Var.Global("i",typeof) && start = <@@ 1 @@> && finish = <@@ 10 @@> && body = <@@ () @@> | _ -> false) true - check "vcknwwe0t" (match Expr.GlobalVar("i") : Expr with Var(v) -> v = Var.Global("i",typeof) | _ -> false) true - check "vcknwwe0y" (match Expr.IfThenElse(<@@ true @@>,<@@ 1 @@>,<@@ 2 @@>) with IfThenElse(gd,t,e) -> gd = <@@ true @@> && t = <@@ 1 @@> && e = <@@ 2 @@> | _ -> false) true - check "vcknwwe0u" (match Expr.Lambda(Var.Global("i",typeof), <@@ 2 @@>) with Lambda(v,b) -> v = Var.Global("i",typeof) && b = <@@ 2 @@> | _ -> false) true - check "vcknwwe0i" (match Expr.Let(Var.Global("i",typeof), <@@ 2 @@>, <@@ 3 @@>) with Let(v,e,b) -> v = Var.Global("i",typeof) && e = <@@ 2 @@> && b = <@@ 3 @@> | _ -> false) true - check "vcknwwe0o" (match Expr.LetRecursive([(Var.Global("i",typeof), <@@ 2 @@>)], <@@ 3 @@>) with LetRecursive([(v,e)],b) -> v = Var.Global("i",typeof) && e = <@@ 2 @@> && b = <@@ 3 @@> | _ -> false) true - check "vcknwwe0p" (match Expr.LetRecursive([(Var.Global("i",typeof), <@@ 2 @@>);(Var.Global("j",typeof), <@@ 3 @@>)], <@@ 3 @@>) with LetRecursive([(v1,e1);(v2,e2)],b) -> v1 = Var.Global("i",typeof) && v2 = Var.Global("j",typeof) && e1 = <@@ 2 @@> && e2 = <@@ 3 @@> && b = <@@ 3 @@> | _ -> false) true - check "vcknwwe0a" (Expr.NewArray(typeof,[ <@@ 1 @@>; <@@ 2 @@> ])) <@@ [| 1;2 |] @@> - check "vcknwwe0s" (match Expr.NewDelegate(typeof>,[ Var.Global("i",typeof) ], <@@ () @@>) with NewDelegate(ty,[v],e) -> ty = typeof> && v = Var.Global("i",typeof) && e = <@@ () @@> | _ -> false) true - check "vcknwwe0d" (match Expr.NewObject(ctorof <@@ new obj() @@> ,[ ]) with NewObject(ty,[]) -> ty = ctorof <@@ new obj() @@> | _ -> false) true - check "vcknwwe0f" (match Expr.NewObject(ctorof <@@ new System.String('a',3) @@> ,[ <@@ 'b' @@>; <@@ 4 @@>]) with NewObject(ty,[x;y]) -> ty = ctorof <@@ new string('a',3) @@> && x = <@@ 'b' @@> && y = <@@ 4 @@> | _ -> false) true - check "vcknwwe0g" (Expr.NewRecord(typeof ,[ <@@ 4 @@> ])) <@@ { contents = 4 } @@> - check "vcknwwe0h" (try let _ = Expr.NewTuple([]) in false with :? System.ArgumentException -> true) true - check "vcknwwe0j" (try let _ = Expr.NewTuple([ <@@ 1 @@> ]) in true with :? System.ArgumentException -> false) true - check "vcknwwe0k" (match Expr.NewTuple([ <@@ 'b' @@>; <@@ 4 @@>]) with NewTuple([x;y]) -> x = <@@ 'b' @@> && y = <@@ 4 @@> | _ -> false) true - check "vcknwwe0l" (Expr.NewTuple([ <@@ 'b' @@>; <@@ 4 @@>])) <@@ ('b',4) @@> - check "vcknwwe0z" (Expr.NewTuple([ <@@ 'b' @@>; <@@ 4 @@>; <@@ 5 @@>])) <@@ ('b',4,5) @@> - check "vcknwwe0x" (Expr.NewTuple([ <@@ 'b' @@>; <@@ 4 @@>; <@@ 5 @@>; <@@ 6 @@>])) <@@ ('b',4,5,6) @@> - check "vcknwwe0c" (Expr.NewTuple([ <@@ 'b' @@>; <@@ 4 @@>; <@@ 5 @@>; <@@ 6 @@>; <@@ 7 @@>])) <@@ ('b',4,5,6,7) @@> - check "vcknwwe0v" (Expr.NewTuple([ <@@ 'b' @@>; <@@ 4 @@>; <@@ 5 @@>; <@@ 6 @@>; <@@ 7 @@>; <@@ 8 @@>])) <@@ ('b',4,5,6,7,8) @@> - check "vcknwwe0b" (Expr.NewTuple([ <@@ 'b' @@>; <@@ 4 @@>; <@@ 5 @@>; <@@ 6 @@>; <@@ 7 @@>; <@@ 8 @@>; <@@ 9 @@>])) <@@ ('b',4,5,6,7,8,9) @@> - check "vcknwwe0n" (Expr.NewTuple([ <@@ 'b' @@>; <@@ 4 @@>; <@@ 5 @@>; <@@ 6 @@>; <@@ 7 @@>; <@@ 8 @@>; <@@ 9 @@>; <@@ 10 @@>])) <@@ ('b',4,5,6,7,8,9,10) @@> - check "vcknwwe0m" (Expr.NewTuple([ <@@ 'b' @@>; <@@ 4 @@>; <@@ 5 @@>; <@@ 6 @@>; <@@ 7 @@>; <@@ 8 @@>; <@@ 9 @@>; <@@ 10 @@>])) <@@ ('b',4,5,6,7,8,9,10) @@> - check "vcknwwe011" (Expr.NewUnionCase(ucaseof <@@ Some(3) @@>,[ <@@ 4 @@> ])) <@@ Some(4) @@> - check "vcknwwe022" (Expr.NewUnionCase(ucaseof <@@ None @@>,[ ])) <@@ None @@> - check "vcknwwe033" (try let _ = Expr.NewUnionCase(ucaseof <@@ Some(3) @@>,[ ]) in false with :? ArgumentException -> true) true - check "vcknwwe044" (try let _ = Expr.NewUnionCase(ucaseof <@@ None @@>,[ <@@ 1 @@> ]) in false with :? ArgumentException -> true) true - check "vcknwwe055" (Expr.PropertyGet(getof <@@ System.DateTime.Now @@>,[ ])) <@@ System.DateTime.Now @@> - check "vcknwwe066" (try let _ = Expr.PropertyGet(getof <@@ System.DateTime.Now @@>,[ <@@ 1 @@> ]) in false with :? ArgumentException -> true) true - check "vcknwwe077" (Expr.PropertyGet(<@@ "3" @@>, getof <@@ "1".Length @@>)) <@@ "3".Length @@> - check "vcknwwe088" (Expr.PropertyGet(<@@ "3" @@>, getof <@@ "1".Length @@>,[ ])) <@@ "3".Length @@> - #if Portable - #else - check "vcknwwe099" (Expr.PropertySet(<@@ (new System.Windows.Forms.Form()) @@>, setof <@@ (new System.Windows.Forms.Form()).Text <- "2" @@>, <@@ "3" @@> )) <@@ (new System.Windows.Forms.Form()).Text <- "3" @@> - #endif - check "vcknwwe099" (Expr.PropertySet(<@@ (new Foo()) @@>, setof <@@ (new Foo()).[3] <- 1 @@>, <@@ 2 @@> , [ <@@ 3 @@> ] )) <@@ (new Foo()).[3] <- 2 @@> -#if FSHARP_CORE_31 -#else - check "vcknwwe0qq1" (Expr.QuoteRaw(<@ "1" @>)) <@@ <@@ "1" @@> @@> - check "vcknwwe0qq2" (Expr.QuoteRaw(<@@ "1" @@>)) <@@ <@@ "1" @@> @@> - check "vcknwwe0qq3" (Expr.QuoteTyped(<@ "1" @>)) <@@ <@ "1" @> @@> - check "vcknwwe0qq4" (Expr.QuoteTyped(<@@ "1" @@>)) <@@ <@ "1" @> @@> -#endif - check "vcknwwe0ww" (Expr.Sequential(<@@ () @@>, <@@ 1 @@>)) <@@ (); 1 @@> - check "vcknwwe0ee" (Expr.TryFinally(<@@ 1 @@>, <@@ () @@>)) <@@ try 1 finally () @@> - check "vcknwwe0rr" (match Expr.TryWith(<@@ 1 @@>, Var.Global("e1",typeof), <@@ 1 @@>, Var.Global("e2",typeof), <@@ 2 @@>) with TryWith(b,v1,ef,v2,eh) -> b = <@@ 1 @@> && eh = <@@ 2 @@> && ef = <@@ 1 @@> && v1 = Var.Global("e1",typeof) && v2 = Var.Global("e2",typeof)| _ -> false) true - check "vcknwwe0tt" (match Expr.TupleGet(<@@ (1,2) @@>, 0) with TupleGet(b,n) -> b = <@@ (1,2) @@> && n = 0 | _ -> false) true - check "vcknwwe0yy" (match Expr.TupleGet(<@@ (1,2) @@>, 1) with TupleGet(b,n) -> b = <@@ (1,2) @@> && n = 1 | _ -> false) true - check "vcknwwe0uu" (try let _ = Expr.TupleGet(<@@ (1,2) @@>, 2) in false with :? ArgumentException -> true) true - check "vcknwwe0ii" (try let _ = Expr.TupleGet(<@@ (1,2) @@>, -1) in false with :? ArgumentException -> true) true - for i = 0 to 7 do - check "vcknwwe0oo" (match Expr.TupleGet(<@@ (1,2,3,4,5,6,7,8) @@>, i) with TupleGet(b,n) -> b = <@@ (1,2,3,4,5,6,7,8) @@> && n = i | _ -> false) true - check "vcknwwe0pp" (match Expr.TypeTest(<@@ new obj() @@>, typeof) with TypeTest(e,ty) -> e = <@@ new obj() @@> && ty = typeof | _ -> false) true - check "vcknwwe0aa" (match Expr.UnionCaseTest(<@@ [] : int list @@>, ucaseof <@@ [] : int list @@> ) with UnionCaseTest(e,uc) -> e = <@@ [] : int list @@> && uc = ucaseof <@@ [] : int list @@> | _ -> false) true - check "vcknwwe0ss" (Expr.Value(3)) <@@ 3 @@> - check "vcknwwe0dd" (match Expr.Var(Var.Global("i",typeof)) with Var(v) -> v = Var.Global("i",typeof) | _ -> false) true - check "vcknwwe0ff" (match Expr.VarSet(Var.Global("i",typeof), <@@ 4 @@>) with VarSet(v,q) -> v = Var.Global("i",typeof) && q = <@@ 4 @@> | _ -> false) true - check "vcknwwe0gg" (match Expr.WhileLoop(<@@ true @@>, <@@ () @@>) with WhileLoop(g,b) -> g = <@@ true @@> && b = <@@ () @@> | _ -> false) true +module QuotationStructUnionTests = + + [] + type T = | A of int + + test "check NewUnionCase" (<@ A(1) @> |> (function NewUnionCase(unionCase,args) -> true | _ -> false)) + + [] + let foo v = match v with | A(1) -> 0 | _ -> 1 + + test "check TryGetReflectedDefinition (local f)" + ((<@ foo (A(1)) @> |> (function Call(None,minfo,args) -> Quotations.Expr.TryGetReflectedDefinition(minfo).IsSome | _ -> false))) + + [] + let test3297327 v = match v with | A(1) -> 0 | _ -> 1 + + test "check TryGetReflectedDefinition (local f)" + ((<@ foo (A(1)) @> |> (function Call(None,minfo,args) -> Quotations.Expr.TryGetReflectedDefinition(minfo).IsSome | _ -> false))) + + + [] + type T2 = + | A1 of int * int + + test "check NewUnionCase" (<@ A1(1,2) @> |> (function NewUnionCase(unionCase,[ Int32 1; Int32 2 ]) -> true | _ -> false)) + + //[] + //type T3 = + // | A1 of int * int + // + //test "check NewUnionCase" (<@ A1(1,2) @> |> (function NewUnionCase(unionCase,[ Int32 1; Int32 2 ]) -> true | _ -> false)) + module EqualityOnExprDoesntFail = let q = <@ 1 @> diff --git a/tests/fsharp/core/tests_core.fs b/tests/fsharp/core/tests_core.fs index 4e2d891b1d2..68ec3baeb85 100644 --- a/tests/fsharp/core/tests_core.fs +++ b/tests/fsharp/core/tests_core.fs @@ -266,8 +266,8 @@ module FsFromCs = let csc = Printf.ksprintf (Commands.csc exec cfg.CSC) let fsc_flags = cfg.fsc_flags - // "%FSC%" %fsc_flags% -a --doc:lib.xml -o:lib.dll -g lib.ml - do! fsc "%s -a --doc:lib.xml -o:lib.dll -g" fsc_flags ["lib.ml"] + // "%FSC%" %fsc_flags% -a --doc:lib.xml -o:lib.dll -g lib.fs + do! fsc "%s -a --doc:lib.xml -o:lib.dll -g" fsc_flags ["lib.fs"] // "%PEVERIFY%" lib.dll do! peverify "lib.dll" @@ -275,8 +275,8 @@ module FsFromCs = // %CSC% /nologo /r:"%FSCOREDLLPATH%" /r:System.Core.dll /r:lib.dll /out:test.exe test.cs do! csc """/nologo /r:"%s" /r:System.Core.dll /r:lib.dll /out:test.exe""" cfg.FSCOREDLLPATH ["test.cs"] - // "%FSC%" %fsc_flags% -a --doc:lib--optimize.xml -o:lib--optimize.dll -g lib.ml - do! fsc """%s -a --doc:lib--optimize.xml -o:lib--optimize.dll -g""" fsc_flags ["lib.ml"] + // "%FSC%" %fsc_flags% -a --doc:lib--optimize.xml -o:lib--optimize.dll -g lib.fs + do! fsc """%s -a --doc:lib--optimize.xml -o:lib--optimize.dll -g""" fsc_flags ["lib.fs"] // "%PEVERIFY%" lib--optimize.dll do! peverify "lib--optimize.dll" @@ -316,8 +316,8 @@ module FsFromFsViaCs = let csc = Printf.ksprintf (Commands.csc exec cfg.CSC) let fsc_flags = cfg.fsc_flags - // "%FSC%" %fsc_flags% -a -o:lib.dll -g lib.ml - do! fsc "%s -a -o:lib.dll -g" fsc_flags ["lib.ml"] + // "%FSC%" %fsc_flags% -a -o:lib.dll -g lib.fs + do! fsc "%s -a -o:lib.dll -g" fsc_flags ["lib.fs"] // "%PEVERIFY%" lib.dll do! peverify "lib.dll" diff --git a/tests/fsharp/project.json b/tests/fsharp/project.json index 5090c2c45fb..9320e7f538e 100644 --- a/tests/fsharp/project.json +++ b/tests/fsharp/project.json @@ -1,25 +1,46 @@ { "dependencies": { - "Microsoft.NETCore.Platforms": "1.0.1-rc2-24027", - "NETStandard.Library": "1.5.0-rc2-24027", - "Microsoft.NETCore.Runtime.CoreCLR": "1.0.2-rc2-24027", - "Microsoft.NETCore.TestHost": "1.0.0-rc2-24027", - "Microsoft.NETCore.ConsoleHost": "1.0.0-rc2-24027", - "System.Collections.Immutable":"1.2.0-rc2-24027", - "System.Diagnostics.Process": "4.1.0-rc2-24027", - "System.Diagnostics.TraceSource": "4.0.0-rc2-24027", - "System.Linq.Expressions": "4.0.11-rc2-24027", - "System.Reflection.Emit": "4.0.1-rc2-24027", - "System.Reflection.Emit.ILGeneration": "4.0.1-rc2-24027", - "System.Reflection.Metadata": "1.3.0-rc2-24027", - "System.Reflection.TypeExtensions": "4.1.0-rc2-24027", - "System.Runtime.InteropServices": "4.1.0-rc2-24027", - "System.Runtime.InteropServices.PInvoke": "4.0.0-rc2-24027", - "System.Runtime.Loader": "4.0.0-rc2-24027", - "System.Security.Cryptography.Algorithms": "4.1.0-rc2-24027", - "System.Security.Cryptography.Primitives": "4.0.0-rc2-24027", - "System.Threading.Thread": "4.0.0-rc2-24027", - "System.Threading.ThreadPool": "4.0.10-rc2-24027" + "Microsoft.NETCore.Platforms": "1.0.1", + "NETStandard.Library": "1.6.0", + "System.Collections": "4.0.11", + "System.Collections.Immutable":"1.2.0", + "System.Console": "4.0.0", + "System.Diagnostics.Debug": "4.0.11", + "System.Diagnostics.Process": "4.1.0", + "System.Diagnostics.Tools": "4.0.1", + "System.Diagnostics.TraceSource": "4.0.0", + "System.Globalization": "4.0.11", + "System.IO": "4.1.0", + "System.Linq": "4.1.0", + "System.Linq.Expressions": "4.1.0", + "System.Linq.Queryable": "4.0.1", + "System.Net.Requests": "4.0.11", + "System.Reflection": "4.1.0", + "System.Reflection.Emit": "4.0.1", + "System.Reflection.Extensions": "4.0.1", + "System.Reflection.Metadata": "1.4.1-beta-24227-04", + "System.Reflection.TypeExtensions": "4.1.0", + "System.Runtime": "4.1.0", + "System.Runtime.Extensions": "4.1.0", + "System.Runtime.InteropServices": "4.1.0", + "System.Runtime.Loader": "4.0.0", + "System.Runtime.Numerics": "4.0.1", + "System.Security.Cryptography.Algorithms": "4.2.0", + "System.Text.RegularExpressions": "4.1.0", + "System.Threading": "4.0.11", + "System.Threading.Tasks": "4.0.11", + "System.Threading.Tasks.Parallel": "4.0.1", + "System.Threading.Thread": "4.0.0", + "System.Threading.ThreadPool": "4.0.10", + "System.Threading.Timer": "4.0.1", + + "Microsoft.DiaSymReader.PortablePdb": "1.1.0", + "Microsoft.DiaSymReader": "1.0.8", + + "Microsoft.NETCore.Runtime.CoreCLR": "1.0.2", + "Microsoft.NETCore.TestHost": "1.0.0", + "System.Reflection.Emit.ILGeneration": "4.0.1", + "System.Security.Cryptography.Primitives": "4.0.0" }, "runtimes": { "win7-x86": { }, @@ -28,6 +49,6 @@ "ubuntu.14.04-x64": { } }, "frameworks": { - "netstandard1.5": { } + "netstandard1.6": { } } } diff --git a/tests/fsharp/single-test-build.bat b/tests/fsharp/single-test-build.bat index 70c16373c15..59e076879b7 100644 --- a/tests/fsharp/single-test-build.bat +++ b/tests/fsharp/single-test-build.bat @@ -127,7 +127,7 @@ set platform=win7-x64 For %%A in ("%cd%") do (Set TestCaseName=%%~nxA) set command_line_args= set command_line_args=%command_line_args% --exec %~d0%~p0..\fsharpqa\testenv\src\deployProj\CompileProj.fsx -set command_line_args=%command_line_args% --targetPlatformName:.NETStandard,Version=v1.5/%platform% +set command_line_args=%command_line_args% --targetPlatformName:.NETStandard,Version=v1.6/%platform% set command_line_args=%command_line_args% --source:"%~d0%~p0coreclr_utilities.fs" --source:"%sources%" set command_line_args=%command_line_args% --packagesDir:%~d0%~p0..\..\packages set command_line_args=%command_line_args% --projectJsonLock:%~d0%~p0project.lock.json diff --git a/tests/fsharp/typecheck/sigs/neg02.bsl b/tests/fsharp/typecheck/sigs/neg02.bsl index 77a47cc01ce..b7119f8e1d4 100644 --- a/tests/fsharp/typecheck/sigs/neg02.bsl +++ b/tests/fsharp/typecheck/sigs/neg02.bsl @@ -3,6 +3,4 @@ neg02.fs(6,8,6,15): parse error FS0046: The identifier 'virtual' is reserved for neg02.fs(6,8,6,15): parse error FS0010: Unexpected identifier in member definition -neg02.fs(11,8,11,14): parse error FS0046: The identifier 'method' is reserved for future use by F# - neg02.fs(17,7,17,13): parse error FS0010: Unexpected keyword 'static' in member definition. Expected 'member', 'override' or other token. diff --git a/tests/fsharp/typecheck/sigs/neg16.bsl b/tests/fsharp/typecheck/sigs/neg16.bsl index 77fd1b5ea23..f73c0cb6c15 100644 --- a/tests/fsharp/typecheck/sigs/neg16.bsl +++ b/tests/fsharp/typecheck/sigs/neg16.bsl @@ -1,5 +1,5 @@ -neg16.fs(7,13,7,16): typecheck error FS0644: Namespaces cannot contain extension members except in the same file and namespace where the type is defined. Consider using a module to hold declarations of extension members. +neg16.fs(7,13,7,16): typecheck error FS0644: Namespaces cannot contain extension members except in the same file and namespace declaration group where the type is defined. Consider using a module to hold declarations of extension members. neg16.fs(23,10,23,11): typecheck error FS0935: Types with the 'AllowNullLiteral' attribute may only inherit from or implement types which also allow the use of the null literal diff --git a/tests/fsharp/typecheck/sigs/neg23.bsl b/tests/fsharp/typecheck/sigs/neg23.bsl index 1d21a9a9a41..43ccae55657 100644 --- a/tests/fsharp/typecheck/sigs/neg23.bsl +++ b/tests/fsharp/typecheck/sigs/neg23.bsl @@ -27,9 +27,9 @@ neg23.fs(82,18,82,20): typecheck error FS0439: The method 'X0' has curried argum neg23.fs(85,18,85,21): typecheck error FS0439: The method 'X01' has curried arguments but has the same name as another method in this type. Methods with curried arguments cannot be overloaded. Consider using a method taking tupled arguments. -neg23.fs(88,18,88,21): typecheck error FS0440: Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition' or 'byref' arguments +neg23.fs(88,18,88,21): typecheck error FS0440: Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition', 'byref', 'CallerLineNumber', 'CallerMemberName', or 'CallerFilePath' arguments -neg23.fs(90,18,90,21): typecheck error FS0440: Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition' or 'byref' arguments +neg23.fs(90,18,90,21): typecheck error FS0440: Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition', 'byref', 'CallerLineNumber', 'CallerMemberName', or 'CallerFilePath' arguments neg23.fs(93,18,93,21): typecheck error FS0439: The method 'X04' has curried arguments but has the same name as another method in this type. Methods with curried arguments cannot be overloaded. Consider using a method taking tupled arguments. diff --git a/tests/fsharp/typecheck/sigs/neg95.bsl b/tests/fsharp/typecheck/sigs/neg95.bsl index 4de448ee8ac..c0cbebc4438 100644 --- a/tests/fsharp/typecheck/sigs/neg95.bsl +++ b/tests/fsharp/typecheck/sigs/neg95.bsl @@ -12,3 +12,7 @@ neg95.fs(32,12,32,18): typecheck error FS3200: In a recursive declaration group, neg95.fs(39,12,39,18): typecheck error FS3200: In a recursive declaration group, 'open' declarations must come first in each module neg95.fs(45,10,45,22): typecheck error FS0954: This type definition involves an immediate cyclic reference through a struct field or inheritance relation + +neg95.fs(52,10,52,21): typecheck error FS0954: This type definition involves an immediate cyclic reference through a struct field or inheritance relation + +neg95.fs(55,10,55,22): typecheck error FS3204: A union type which is a struct must have only one case. \ No newline at end of file diff --git a/tests/fsharp/typecheck/sigs/neg95.fs b/tests/fsharp/typecheck/sigs/neg95.fs index 4fb7e060b09..dc00e8d29b3 100644 --- a/tests/fsharp/typecheck/sigs/neg95.fs +++ b/tests/fsharp/typecheck/sigs/neg95.fs @@ -47,3 +47,9 @@ namespace Neg95B X: float Y: StructRecord } + + [] + type StructUnion = StructUnion of float * StructUnion + + [] + type StructUnion2 = A of int | B of string diff --git a/tests/fsharp/typecheck/sigs/neg96.bsl b/tests/fsharp/typecheck/sigs/neg96.bsl index 29902eb4c44..994e057b521 100644 --- a/tests/fsharp/typecheck/sigs/neg96.bsl +++ b/tests/fsharp/typecheck/sigs/neg96.bsl @@ -1,2 +1,8 @@ -neg95.fs(11,9,11,21): typecheck error FS0039: The value or constructor 'StructRecord' is not defined \ No newline at end of file +neg95.fs(11,9,11,21): typecheck error FS0039: The value or constructor 'StructRecord' is not defined + +neg96.fs(14,17,14,18): typecheck error FS3205: This feature is deprecated. A 'use' binding may not be marked 'mutable'. + +neg96.fs(18,10,18,11): typecheck error FS0039: The type 'X' is not defined + +neg96.fs(18,10,18,11): typecheck error FS0039: The type 'X' is not defined \ No newline at end of file diff --git a/tests/fsharp/typecheck/sigs/neg96.fs b/tests/fsharp/typecheck/sigs/neg96.fs index e46b8fb7fee..fef81522e0b 100644 --- a/tests/fsharp/typecheck/sigs/neg96.fs +++ b/tests/fsharp/typecheck/sigs/neg96.fs @@ -9,3 +9,11 @@ type StructRecord = } let x = StructRecord () + +let invalidUse() = + use mutable x = (null : System.IDisposable) + () + + +type T = X<__SOURCE_DIRECTORY__> + diff --git a/tests/fsharp/typecheck/sigs/neg97.bsl b/tests/fsharp/typecheck/sigs/neg97.bsl index 4353b29ffc2..860f9fd6f37 100644 --- a/tests/fsharp/typecheck/sigs/neg97.bsl +++ b/tests/fsharp/typecheck/sigs/neg97.bsl @@ -1,2 +1,10 @@ -neg96.fs(13,1,13,2): typecheck error FS0256: A value must be mutable in order to mutate the contents or take the address of a value type, e.g. 'let mutable x = ...' \ No newline at end of file +neg97.fs(13,1,13,2): typecheck error FS0256: A value must be mutable in order to mutate the contents or take the address of a value type, e.g. 'let mutable x = ...' + +neg97.fs(16,9,16,10): typecheck error FS3207: Invalid use of 'fixed'. 'fixed' may only be used in a declaration of the form 'use x = fixed expr' where the expression is an array, the address of a field, the address of an array element or a string' + +neg97.fs(20,9,20,10): typecheck error FS3207: Invalid use of 'fixed'. 'fixed' may only be used in a declaration of the form 'use x = fixed expr' where the expression is an array, the address of a field, the address of an array element or a string' + +neg97.fs(25,9,25,10): typecheck error FS3207: Invalid use of 'fixed'. 'fixed' may only be used in a declaration of the form 'use x = fixed expr' where the expression is an array, the address of a field, the address of an array element or a string' + +neg97.fs(30,9,30,10): typecheck error FS3207: Invalid use of 'fixed'. 'fixed' may only be used in a declaration of the form 'use x = fixed expr' where the expression is an array, the address of a field, the address of an array element or a string' diff --git a/tests/fsharp/typecheck/sigs/neg97.fs b/tests/fsharp/typecheck/sigs/neg97.fs index 67a7b104b29..01f68256c9a 100644 --- a/tests/fsharp/typecheck/sigs/neg97.fs +++ b/tests/fsharp/typecheck/sigs/neg97.fs @@ -12,3 +12,20 @@ let x = { X = 1.; Y = 1. } x.Y <- 5. +let pinIntNotAllowed() = + use p = fixed 3 + () + +let pinAnyNotAllowed(x: 'T) = + use p = fixed x + () + +let pinStackAddressNotAllowed(x: 'T) = + let mutable v = 0 + use p = fixed &v + () + +let pinStructAddressNotAllowed(x: 'T) = + let mutable v = { X = 1.0; Y = 1.0 } + use p = fixed &v.Y + () diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl index 075b68845ee..972eced84a0 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00001158 Length: 0x000003FD } .module TopLevelModule.dll -// MVID: {575BE147-37F5-C118-A745-038347E15B57} +// MVID: {576266DB-37F5-C118-A745-0383DB666257} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x00620000 +// Image base: 0x01090000 // =============== CLASS MEMBERS DECLARATION =================== @@ -685,7 +685,7 @@ IL_0019: ldloc.0 IL_001a: stloc.1 - IL_001b: ldloc.1 + IL_001b: ldloc.0 IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) IL_0021: brtrue.s IL_0025 @@ -1483,7 +1483,7 @@ IL_0019: ldloc.0 IL_001a: stloc.1 - IL_001b: ldloc.1 + IL_001b: ldloc.0 IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) IL_0021: brtrue.s IL_0025 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModuleP.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModuleP.il.bsl index 76df7a86bfb..51e5cc6249a 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModuleP.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModuleP.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00001158 Length: 0x000003FE } .module ToplevelModuleP.dll -// MVID: {575BE155-5A3A-8E4D-A745-038355E15B57} +// MVID: {576266E1-5A3A-8E4D-A745-0383E1666257} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x009B0000 +// Image base: 0x00A70000 // =============== CLASS MEMBERS DECLARATION =================== @@ -671,7 +671,7 @@ IL_0019: ldloc.0 IL_001a: stloc.1 - IL_001b: ldloc.1 + IL_001b: ldloc.0 IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) IL_0021: brtrue.s IL_0025 @@ -1455,7 +1455,7 @@ IL_0019: ldloc.0 IL_001a: stloc.1 - IL_001b: ldloc.1 + IL_001b: ldloc.0 IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) IL_0021: brtrue.s IL_0025 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl index 1d33d16bc4c..b9d03a5dc59 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00001860 Length: 0x0000055C } .module ToplevelNamespace.dll -// MVID: {575BE14E-218B-729A-A745-03834EE15B57} +// MVID: {576266DE-218B-729A-A745-0383DE666257} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x00F30000 +// Image base: 0x00D30000 // =============== CLASS MEMBERS DECLARATION =================== @@ -680,7 +680,7 @@ IL_0019: ldloc.0 IL_001a: stloc.1 - IL_001b: ldloc.1 + IL_001b: ldloc.0 IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) IL_0021: brtrue.s IL_0025 @@ -1478,7 +1478,7 @@ IL_0019: ldloc.0 IL_001a: stloc.1 - IL_001b: ldloc.1 + IL_001b: ldloc.0 IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) IL_0021: brtrue.s IL_0025 @@ -2276,7 +2276,7 @@ IL_0019: ldloc.0 IL_001a: stloc.1 - IL_001b: ldloc.1 + IL_001b: ldloc.0 IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) IL_0021: brtrue.s IL_0025 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespaceP.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespaceP.il.bsl index 15931872229..a419b7a9c0c 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespaceP.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespaceP.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00001860 Length: 0x0000055D } .module ToplevelNamespaceP.dll -// MVID: {575BE15B-88D9-D7FD-A745-03835BE15B57} +// MVID: {576266E4-88D9-D7FD-A745-0383E4666257} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x003C0000 +// Image base: 0x01450000 // =============== CLASS MEMBERS DECLARATION =================== @@ -666,7 +666,7 @@ IL_0019: ldloc.0 IL_001a: stloc.1 - IL_001b: ldloc.1 + IL_001b: ldloc.0 IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) IL_0021: brtrue.s IL_0025 @@ -1450,7 +1450,7 @@ IL_0019: ldloc.0 IL_001a: stloc.1 - IL_001b: ldloc.1 + IL_001b: ldloc.0 IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) IL_0021: brtrue.s IL_0025 @@ -2234,7 +2234,7 @@ IL_0019: ldloc.0 IL_001a: stloc.1 - IL_001b: ldloc.1 + IL_001b: ldloc.0 IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) IL_0021: brtrue.s IL_0025 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction24.il.netfx4.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction24.il.netfx4.bsl new file mode 100644 index 00000000000..244989e3132 --- /dev/null +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction24.il.netfx4.bsl @@ -0,0 +1,1009 @@ + +// Microsoft (R) .NET Framework IL Disassembler. Version 4.6.81.0 +// Copyright (c) Microsoft Corporation. All rights reserved. + + + +// Metadata version: v4.0.30319 +.assembly extern mscorlib +{ + .publickeytoken = (B7 7A 5C 56 19 34 E0 89 ) // .z\V.4.. + .ver 4:0:0:0 +} +.assembly extern FSharp.Core +{ + .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: + .ver 4:4:1:0 +} +.assembly TestFunction24 +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.FSharpInterfaceDataVersionAttribute::.ctor(int32, + int32, + int32) = ( 01 00 02 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + + // --- The following custom attribute is added automatically, do not uncomment ------- + // .custom instance void [mscorlib]System.Diagnostics.DebuggableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggableAttribute/DebuggingModes) = ( 01 00 00 01 00 00 00 00 ) + + .hash algorithm 0x00008004 + .ver 0:0:0:0 +} +.mresource public FSharpSignatureData.TestFunction24 +{ + // Offset: 0x00000000 Length: 0x0000075B +} +.mresource public FSharpOptimizationData.TestFunction24 +{ + // Offset: 0x00000760 Length: 0x00000228 +} +.module TestFunction24.exe +// MVID: {5769ACB2-A643-4587-A745-0383B2AC6957} +.imagebase 0x00400000 +.file alignment 0x00000200 +.stackreserve 0x00100000 +.subsystem 0x0003 // WINDOWS_CUI +.corflags 0x00000001 // ILONLY +// Image base: 0x007A0000 + + +// =============== CLASS MEMBERS DECLARATION =================== + +.class public abstract auto ansi sealed TestFunction24 + extends [mscorlib]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto ansi serializable sealed nested public Point + extends [mscorlib]System.Object + implements class [mscorlib]System.IEquatable`1, + [mscorlib]System.Collections.IStructuralEquatable, + class [mscorlib]System.IComparable`1, + [mscorlib]System.IComparable, + [mscorlib]System.Collections.IStructuralComparable + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 02 00 00 00 00 00 ) + .field public int32 x@ + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .field public int32 y@ + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .method public hidebysig specialname + instance int32 get_x() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 TestFunction24/Point::x@ + IL_0006: ret + } // end of method Point::get_x + + .method public hidebysig specialname + instance int32 get_y() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 TestFunction24/Point::y@ + IL_0006: ret + } // end of method Point::get_y + + .method public hidebysig specialname + instance void set_x(int32 'value') cil managed + { + // Code size 8 (0x8) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: stfld int32 TestFunction24/Point::x@ + IL_0007: ret + } // end of method Point::set_x + + .method public hidebysig specialname + instance void set_y(int32 'value') cil managed + { + // Code size 8 (0x8) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: stfld int32 TestFunction24/Point::y@ + IL_0007: ret + } // end of method Point::set_y + + .method public specialname rtspecialname + instance void .ctor(int32 x, + int32 y) cil managed + { + // Code size 21 (0x15) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 TestFunction24/Point::x@ + IL_000d: ldarg.0 + IL_000e: ldarg.2 + IL_000f: stfld int32 TestFunction24/Point::y@ + IL_0014: ret + } // end of method Point::.ctor + + .method public hidebysig virtual final + instance int32 CompareTo(class TestFunction24/Point obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 143 (0x8f) + .maxstack 4 + .locals init (int32 V_0, + class [mscorlib]System.Collections.IComparer V_1, + int32 V_2, + int32 V_3, + class [mscorlib]System.Collections.IComparer V_4, + int32 V_5, + int32 V_6) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000e + + IL_0009: br IL_0081 + + IL_000e: ldarg.1 + IL_000f: ldnull + IL_0010: cgt.un + IL_0012: brfalse.s IL_0016 + + IL_0014: br.s IL_001b + + IL_0016: br IL_007f + + IL_001b: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() + IL_0020: stloc.1 + IL_0021: ldarg.0 + IL_0022: ldfld int32 TestFunction24/Point::x@ + IL_0027: stloc.2 + IL_0028: ldarg.1 + IL_0029: ldfld int32 TestFunction24/Point::x@ + IL_002e: stloc.3 + IL_002f: ldloc.2 + IL_0030: ldloc.3 + IL_0031: bge.s IL_0035 + + IL_0033: br.s IL_0037 + + IL_0035: br.s IL_003b + + IL_0037: ldc.i4.m1 + IL_0038: nop + IL_0039: br.s IL_0040 + + IL_003b: ldloc.2 + IL_003c: ldloc.3 + IL_003d: cgt + IL_003f: nop + IL_0040: stloc.0 + IL_0041: ldloc.0 + IL_0042: ldc.i4.0 + IL_0043: bge.s IL_0047 + + IL_0045: br.s IL_0049 + + IL_0047: br.s IL_004b + + IL_0049: ldloc.0 + IL_004a: ret + + IL_004b: ldloc.0 + IL_004c: ldc.i4.0 + IL_004d: ble.s IL_0051 + + IL_004f: br.s IL_0053 + + IL_0051: br.s IL_0055 + + IL_0053: ldloc.0 + IL_0054: ret + + IL_0055: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() + IL_005a: stloc.s V_4 + IL_005c: ldarg.0 + IL_005d: ldfld int32 TestFunction24/Point::y@ + IL_0062: stloc.s V_5 + IL_0064: ldarg.1 + IL_0065: ldfld int32 TestFunction24/Point::y@ + IL_006a: stloc.s V_6 + IL_006c: ldloc.s V_5 + IL_006e: ldloc.s V_6 + IL_0070: bge.s IL_0074 + + IL_0072: br.s IL_0076 + + IL_0074: br.s IL_0078 + + IL_0076: ldc.i4.m1 + IL_0077: ret + + IL_0078: ldloc.s V_5 + IL_007a: ldloc.s V_6 + IL_007c: cgt + IL_007e: ret + + IL_007f: ldc.i4.1 + IL_0080: ret + + IL_0081: ldarg.1 + IL_0082: ldnull + IL_0083: cgt.un + IL_0085: brfalse.s IL_0089 + + IL_0087: br.s IL_008b + + IL_0089: br.s IL_008d + + IL_008b: ldc.i4.m1 + IL_008c: ret + + IL_008d: ldc.i4.0 + IL_008e: ret + } // end of method Point::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' + .line 4,4 : 6,11 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\TestFunctions\\TestFunction24.fs' + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldarg.1 + IL_0003: unbox.any TestFunction24/Point + IL_0008: callvirt instance int32 TestFunction24/Point::CompareTo(class TestFunction24/Point) + IL_000d: ret + } // end of method Point::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj, + class [mscorlib]System.Collections.IComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 160 (0xa0) + .maxstack 4 + .locals init ([0] class TestFunction24/Point V_0, + [1] class TestFunction24/Point V_1, + [2] int32 V_2, + [3] class [mscorlib]System.Collections.IComparer V_3, + [4] int32 V_4, + [5] int32 V_5, + [6] class [mscorlib]System.Collections.IComparer V_6, + [7] int32 V_7, + [8] int32 V_8) + .line 4,4 : 6,11 '' + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: unbox.any TestFunction24/Point + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: stloc.1 + IL_000a: ldarg.0 + IL_000b: ldnull + IL_000c: cgt.un + IL_000e: brfalse.s IL_0012 + + IL_0010: br.s IL_0017 + + IL_0012: br IL_008d + + .line 16707566,16707566 : 0,0 '' + IL_0017: ldarg.1 + IL_0018: unbox.any TestFunction24/Point + IL_001d: ldnull + IL_001e: cgt.un + IL_0020: brfalse.s IL_0024 + + IL_0022: br.s IL_0029 + + IL_0024: br IL_008b + + .line 16707566,16707566 : 0,0 '' + IL_0029: ldarg.2 + IL_002a: stloc.3 + IL_002b: ldarg.0 + IL_002c: ldfld int32 TestFunction24/Point::x@ + IL_0031: stloc.s V_4 + IL_0033: ldloc.1 + IL_0034: ldfld int32 TestFunction24/Point::x@ + IL_0039: stloc.s V_5 + IL_003b: ldloc.s V_4 + IL_003d: ldloc.s V_5 + IL_003f: bge.s IL_0043 + + IL_0041: br.s IL_0045 + + IL_0043: br.s IL_0049 + + .line 16707566,16707566 : 0,0 '' + IL_0045: ldc.i4.m1 + .line 16707566,16707566 : 0,0 '' + IL_0046: nop + IL_0047: br.s IL_0050 + + .line 16707566,16707566 : 0,0 '' + IL_0049: ldloc.s V_4 + IL_004b: ldloc.s V_5 + IL_004d: cgt + .line 16707566,16707566 : 0,0 '' + IL_004f: nop + .line 16707566,16707566 : 0,0 '' + IL_0050: stloc.2 + IL_0051: ldloc.2 + IL_0052: ldc.i4.0 + IL_0053: bge.s IL_0057 + + IL_0055: br.s IL_0059 + + IL_0057: br.s IL_005b + + .line 16707566,16707566 : 0,0 '' + IL_0059: ldloc.2 + IL_005a: ret + + .line 16707566,16707566 : 0,0 '' + IL_005b: ldloc.2 + IL_005c: ldc.i4.0 + IL_005d: ble.s IL_0061 + + IL_005f: br.s IL_0063 + + IL_0061: br.s IL_0065 + + .line 16707566,16707566 : 0,0 '' + IL_0063: ldloc.2 + IL_0064: ret + + .line 16707566,16707566 : 0,0 '' + IL_0065: ldarg.2 + IL_0066: stloc.s V_6 + IL_0068: ldarg.0 + IL_0069: ldfld int32 TestFunction24/Point::y@ + IL_006e: stloc.s V_7 + IL_0070: ldloc.1 + IL_0071: ldfld int32 TestFunction24/Point::y@ + IL_0076: stloc.s V_8 + IL_0078: ldloc.s V_7 + IL_007a: ldloc.s V_8 + IL_007c: bge.s IL_0080 + + IL_007e: br.s IL_0082 + + IL_0080: br.s IL_0084 + + .line 16707566,16707566 : 0,0 '' + IL_0082: ldc.i4.m1 + IL_0083: ret + + .line 16707566,16707566 : 0,0 '' + IL_0084: ldloc.s V_7 + IL_0086: ldloc.s V_8 + IL_0088: cgt + IL_008a: ret + + .line 16707566,16707566 : 0,0 '' + IL_008b: ldc.i4.1 + IL_008c: ret + + .line 16707566,16707566 : 0,0 '' + IL_008d: ldarg.1 + IL_008e: unbox.any TestFunction24/Point + IL_0093: ldnull + IL_0094: cgt.un + IL_0096: brfalse.s IL_009a + + IL_0098: br.s IL_009c + + IL_009a: br.s IL_009e + + .line 16707566,16707566 : 0,0 '' + IL_009c: ldc.i4.m1 + IL_009d: ret + + .line 16707566,16707566 : 0,0 '' + IL_009e: ldc.i4.0 + IL_009f: ret + } // end of method Point::CompareTo + + .method public hidebysig virtual final + instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 63 (0x3f) + .maxstack 7 + .locals init (int32 V_0, + class [mscorlib]System.Collections.IEqualityComparer V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_003d + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldc.i4 0x9e3779b9 + IL_0012: ldarg.1 + IL_0013: stloc.1 + IL_0014: ldarg.0 + IL_0015: ldfld int32 TestFunction24/Point::y@ + IL_001a: ldloc.0 + IL_001b: ldc.i4.6 + IL_001c: shl + IL_001d: ldloc.0 + IL_001e: ldc.i4.2 + IL_001f: shr + IL_0020: add + IL_0021: add + IL_0022: add + IL_0023: stloc.0 + IL_0024: ldc.i4 0x9e3779b9 + IL_0029: ldarg.1 + IL_002a: stloc.2 + IL_002b: ldarg.0 + IL_002c: ldfld int32 TestFunction24/Point::x@ + IL_0031: ldloc.0 + IL_0032: ldc.i4.6 + IL_0033: shl + IL_0034: ldloc.0 + IL_0035: ldc.i4.2 + IL_0036: shr + IL_0037: add + IL_0038: add + IL_0039: add + IL_003a: stloc.0 + IL_003b: ldloc.0 + IL_003c: ret + + IL_003d: ldc.i4.0 + IL_003e: ret + } // end of method Point::GetHashCode + + .method public hidebysig virtual final + instance int32 GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 4,4 : 6,11 '' + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 TestFunction24/Point::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method Point::GetHashCode + + .method public hidebysig virtual final + instance bool Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 78 (0x4e) + .maxstack 4 + .locals init (class TestFunction24/Point V_0, + class TestFunction24/Point V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2, + class [mscorlib]System.Collections.IEqualityComparer V_3) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0046 + + IL_000b: ldarg.1 + IL_000c: isinst TestFunction24/Point + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0044 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldarg.2 + IL_001c: stloc.2 + IL_001d: ldarg.0 + IL_001e: ldfld int32 TestFunction24/Point::x@ + IL_0023: ldloc.1 + IL_0024: ldfld int32 TestFunction24/Point::x@ + IL_0029: ceq + IL_002b: brfalse.s IL_002f + + IL_002d: br.s IL_0031 + + IL_002f: br.s IL_0042 + + IL_0031: ldarg.2 + IL_0032: stloc.3 + IL_0033: ldarg.0 + IL_0034: ldfld int32 TestFunction24/Point::y@ + IL_0039: ldloc.1 + IL_003a: ldfld int32 TestFunction24/Point::y@ + IL_003f: ceq + IL_0041: ret + + IL_0042: ldc.i4.0 + IL_0043: ret + + IL_0044: ldc.i4.0 + IL_0045: ret + + IL_0046: ldarg.1 + IL_0047: ldnull + IL_0048: cgt.un + IL_004a: ldc.i4.0 + IL_004b: ceq + IL_004d: ret + } // end of method Point::Equals + + .method public hidebysig virtual final + instance bool Equals(class TestFunction24/Point obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 66 (0x42) + .maxstack 4 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_003a + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_0038 + + IL_0015: ldarg.0 + IL_0016: ldfld int32 TestFunction24/Point::x@ + IL_001b: ldarg.1 + IL_001c: ldfld int32 TestFunction24/Point::x@ + IL_0021: bne.un.s IL_0025 + + IL_0023: br.s IL_0027 + + IL_0025: br.s IL_0036 + + IL_0027: ldarg.0 + IL_0028: ldfld int32 TestFunction24/Point::y@ + IL_002d: ldarg.1 + IL_002e: ldfld int32 TestFunction24/Point::y@ + IL_0033: ceq + IL_0035: ret + + IL_0036: ldc.i4.0 + IL_0037: ret + + IL_0038: ldc.i4.0 + IL_0039: ret + + IL_003a: ldarg.1 + IL_003b: ldnull + IL_003c: cgt.un + IL_003e: ldc.i4.0 + IL_003f: ceq + IL_0041: ret + } // end of method Point::Equals + + .method public hidebysig virtual final + instance bool Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class TestFunction24/Point V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst TestFunction24/Point + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool TestFunction24/Point::Equals(class TestFunction24/Point) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method Point::Equals + + .property instance int32 x() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) + .set instance void TestFunction24/Point::set_x(int32) + .get instance int32 TestFunction24/Point::get_x() + } // end of property Point::x + .property instance int32 y() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 04 00 00 00 01 00 00 00 00 00 ) + .set instance void TestFunction24/Point::set_y(int32) + .get instance int32 TestFunction24/Point::get_y() + } // end of property Point::y + } // end of class Point + + .method public static int32 pinObject() cil managed + { + // Code size 67 (0x43) + .maxstack 6 + .locals init ([0] class TestFunction24/Point point, + [1] native int p1, + [2] int32& pinned V_2, + [3] native int V_3, + [4] int32 V_4, + [5] native int V_5, + [6] int32 V_6) + .line 7,7 : 5,33 '' + IL_0000: nop + IL_0001: ldc.i4.1 + IL_0002: ldc.i4.2 + IL_0003: newobj instance void TestFunction24/Point::.ctor(int32, + int32) + IL_0008: stloc.0 + .line 8,8 : 5,28 '' + IL_0009: ldloc.0 + IL_000a: ldflda int32 TestFunction24/Point::x@ + IL_000f: stloc.2 + IL_0010: ldloc.2 + IL_0011: conv.i + IL_0012: stloc.1 + .line 9,9 : 5,44 '' + IL_0013: ldloc.1 + IL_0014: stloc.3 + IL_0015: ldc.i4.0 + IL_0016: stloc.s V_4 + IL_0018: ldloc.3 + IL_0019: ldloc.s V_4 + IL_001b: conv.i + IL_001c: sizeof [mscorlib]System.Int32 + IL_0022: mul + IL_0023: add + IL_0024: ldobj [mscorlib]System.Int32 + IL_0029: ldloc.1 + IL_002a: stloc.s V_5 + IL_002c: ldc.i4.1 + IL_002d: stloc.s V_6 + IL_002f: ldloc.s V_5 + IL_0031: ldloc.s V_6 + IL_0033: conv.i + IL_0034: sizeof [mscorlib]System.Int32 + IL_003a: mul + IL_003b: add + IL_003c: ldobj [mscorlib]System.Int32 + IL_0041: add + IL_0042: ret + } // end of method TestFunction24::pinObject + + .method public static int32 pinRef() cil managed + { + // Code size 33 (0x21) + .maxstack 4 + .locals init ([0] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 point, + [1] native int p1, + [2] int32& pinned V_2) + .line 12,12 : 5,23 '' + IL_0000: nop + IL_0001: ldc.i4.s 17 + IL_0003: call class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 [FSharp.Core]Microsoft.FSharp.Core.Operators::Ref(!!0) + IL_0008: stloc.0 + .line 13,13 : 5,35 '' + IL_0009: ldloc.0 + IL_000a: ldflda !0 class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1::contents@ + IL_000f: stloc.2 + IL_0010: ldloc.2 + IL_0011: conv.i + IL_0012: stloc.1 + .line 14,14 : 5,42 '' + IL_0013: ldloc.1 + IL_0014: ldobj [mscorlib]System.Int32 + IL_0019: ldloc.1 + IL_001a: ldobj [mscorlib]System.Int32 + IL_001f: add + IL_0020: ret + } // end of method TestFunction24::pinRef + + .method public static float64 pinArray1() cil managed + { + // Code size 197 (0xc5) + .maxstack 6 + .locals init ([0] float64[] arr, + [1] native int p1, + [2] float64[] V_2, + [3] float64& pinned V_3, + [4] native int V_4, + [5] int32 V_5, + [6] native int V_6, + [7] int32 V_7) + .line 17,17 : 5,49 '' + IL_0000: nop + IL_0001: ldc.i4.6 + IL_0002: newarr [mscorlib]System.Double + IL_0007: dup + IL_0008: ldc.i4.0 + IL_0009: ldc.r8 0.0 + IL_0012: stelem [mscorlib]System.Double + IL_0017: dup + IL_0018: ldc.i4.1 + IL_0019: ldc.r8 1.5 + IL_0022: stelem [mscorlib]System.Double + IL_0027: dup + IL_0028: ldc.i4.2 + IL_0029: ldc.r8 2.2999999999999998 + IL_0032: stelem [mscorlib]System.Double + IL_0037: dup + IL_0038: ldc.i4.3 + IL_0039: ldc.r8 3.3999999999999999 + IL_0042: stelem [mscorlib]System.Double + IL_0047: dup + IL_0048: ldc.i4.4 + IL_0049: ldc.r8 4. + IL_0052: stelem [mscorlib]System.Double + IL_0057: dup + IL_0058: ldc.i4.5 + IL_0059: ldc.r8 5.9000000000000004 + IL_0062: stelem [mscorlib]System.Double + IL_0067: stloc.0 + .line 18,18 : 5,23 '' + IL_0068: ldloc.0 + IL_0069: stloc.2 + IL_006a: ldloc.2 + IL_006b: brfalse.s IL_006f + + IL_006d: br.s IL_0071 + + IL_006f: br.s IL_008f + + .line 16707566,16707566 : 0,0 '' + IL_0071: ldloc.2 + IL_0072: call int32 [FSharp.Core]Microsoft.FSharp.Collections.ArrayModule::Length(!!0[]) + IL_0077: brfalse.s IL_007b + + IL_0079: br.s IL_007d + + IL_007b: br.s IL_008a + + .line 16707566,16707566 : 0,0 '' + IL_007d: ldloc.2 + IL_007e: ldc.i4.0 + IL_007f: ldelema [mscorlib]System.Double + IL_0084: stloc.3 + IL_0085: ldloc.3 + IL_0086: conv.i + .line 16707566,16707566 : 0,0 '' + IL_0087: nop + IL_0088: br.s IL_0092 + + .line 16707566,16707566 : 0,0 '' + IL_008a: ldc.i4.0 + IL_008b: conv.i + .line 16707566,16707566 : 0,0 '' + IL_008c: nop + IL_008d: br.s IL_0092 + + .line 16707566,16707566 : 0,0 '' + IL_008f: ldc.i4.0 + IL_0090: conv.i + .line 16707566,16707566 : 0,0 '' + IL_0091: nop + .line 16707566,16707566 : 0,0 '' + IL_0092: stloc.1 + .line 19,19 : 5,44 '' + IL_0093: ldloc.1 + IL_0094: stloc.s V_4 + IL_0096: ldc.i4.0 + IL_0097: stloc.s V_5 + IL_0099: ldloc.s V_4 + IL_009b: ldloc.s V_5 + IL_009d: conv.i + IL_009e: sizeof [mscorlib]System.Double + IL_00a4: mul + IL_00a5: add + IL_00a6: ldobj [mscorlib]System.Double + IL_00ab: ldloc.1 + IL_00ac: stloc.s V_6 + IL_00ae: ldc.i4.1 + IL_00af: stloc.s V_7 + IL_00b1: ldloc.s V_6 + IL_00b3: ldloc.s V_7 + IL_00b5: conv.i + IL_00b6: sizeof [mscorlib]System.Double + IL_00bc: mul + IL_00bd: add + IL_00be: ldobj [mscorlib]System.Double + IL_00c3: add + IL_00c4: ret + } // end of method TestFunction24::pinArray1 + + .method public static float64 pinArray2() cil managed + { + // Code size 163 (0xa3) + .maxstack 6 + .locals init ([0] float64[] arr, + [1] native int p, + [2] float64& pinned V_2, + [3] native int V_3, + [4] int32 V_4, + [5] native int V_5, + [6] int32 V_6) + .line 22,22 : 5,49 '' + IL_0000: nop + IL_0001: ldc.i4.6 + IL_0002: newarr [mscorlib]System.Double + IL_0007: dup + IL_0008: ldc.i4.0 + IL_0009: ldc.r8 0.0 + IL_0012: stelem [mscorlib]System.Double + IL_0017: dup + IL_0018: ldc.i4.1 + IL_0019: ldc.r8 1.5 + IL_0022: stelem [mscorlib]System.Double + IL_0027: dup + IL_0028: ldc.i4.2 + IL_0029: ldc.r8 2.2999999999999998 + IL_0032: stelem [mscorlib]System.Double + IL_0037: dup + IL_0038: ldc.i4.3 + IL_0039: ldc.r8 3.3999999999999999 + IL_0042: stelem [mscorlib]System.Double + IL_0047: dup + IL_0048: ldc.i4.4 + IL_0049: ldc.r8 4. + IL_0052: stelem [mscorlib]System.Double + IL_0057: dup + IL_0058: ldc.i4.5 + IL_0059: ldc.r8 5.9000000000000004 + IL_0062: stelem [mscorlib]System.Double + IL_0067: stloc.0 + .line 24,24 : 5,27 '' + IL_0068: ldloc.0 + IL_0069: ldc.i4.0 + IL_006a: ldelema [mscorlib]System.Double + IL_006f: stloc.2 + IL_0070: ldloc.2 + IL_0071: conv.i + IL_0072: stloc.1 + .line 25,25 : 5,42 '' + IL_0073: ldloc.1 + IL_0074: stloc.3 + IL_0075: ldc.i4.0 + IL_0076: stloc.s V_4 + IL_0078: ldloc.3 + IL_0079: ldloc.s V_4 + IL_007b: conv.i + IL_007c: sizeof [mscorlib]System.Double + IL_0082: mul + IL_0083: add + IL_0084: ldobj [mscorlib]System.Double + IL_0089: ldloc.1 + IL_008a: stloc.s V_5 + IL_008c: ldc.i4.1 + IL_008d: stloc.s V_6 + IL_008f: ldloc.s V_5 + IL_0091: ldloc.s V_6 + IL_0093: conv.i + IL_0094: sizeof [mscorlib]System.Double + IL_009a: mul + IL_009b: add + IL_009c: ldobj [mscorlib]System.Double + IL_00a1: add + IL_00a2: ret + } // end of method TestFunction24::pinArray2 + + .method public static class [mscorlib]System.Tuple`2 + pinString() cil managed + { + // Code size 82 (0x52) + .maxstack 6 + .locals init ([0] string str, + [1] native int pChar, + [2] string pinned V_2, + [3] native int V_3, + [4] int32 V_4, + [5] native int V_5, + [6] int32 V_6) + .line 28,28 : 5,28 '' + IL_0000: nop + IL_0001: ldstr "Hello World" + IL_0006: stloc.0 + .line 30,30 : 5,26 '' + IL_0007: ldloc.0 + IL_0008: stloc.2 + IL_0009: ldloc.2 + IL_000a: brfalse.s IL_000e + + IL_000c: br.s IL_0010 + + IL_000e: br.s IL_001b + + .line 16707566,16707566 : 0,0 '' + IL_0010: ldloc.2 + IL_0011: conv.i + IL_0012: call int32 [mscorlib]System.Runtime.CompilerServices.RuntimeHelpers::get_OffsetToStringData() + IL_0017: add + .line 16707566,16707566 : 0,0 '' + IL_0018: nop + IL_0019: br.s IL_001d + + .line 16707566,16707566 : 0,0 '' + IL_001b: ldloc.2 + .line 16707566,16707566 : 0,0 '' + IL_001c: nop + .line 16707566,16707566 : 0,0 '' + IL_001d: stloc.1 + .line 31,31 : 5,50 '' + IL_001e: ldloc.1 + IL_001f: stloc.3 + IL_0020: ldc.i4.0 + IL_0021: stloc.s V_4 + IL_0023: ldloc.3 + IL_0024: ldloc.s V_4 + IL_0026: conv.i + IL_0027: sizeof [mscorlib]System.Char + IL_002d: mul + IL_002e: add + IL_002f: ldobj [mscorlib]System.Char + IL_0034: ldloc.1 + IL_0035: stloc.s V_5 + IL_0037: ldc.i4.1 + IL_0038: stloc.s V_6 + IL_003a: ldloc.s V_5 + IL_003c: ldloc.s V_6 + IL_003e: conv.i + IL_003f: sizeof [mscorlib]System.Char + IL_0045: mul + IL_0046: add + IL_0047: ldobj [mscorlib]System.Char + IL_004c: newobj instance void class [mscorlib]System.Tuple`2::.ctor(!0, + !1) + IL_0051: ret + } // end of method TestFunction24::pinString + +} // end of class TestFunction24 + +.class private abstract auto ansi sealed ''.$TestFunction24 + extends [mscorlib]System.Object +{ + .method public static void main@() cil managed + { + .entrypoint + // Code size 2 (0x2) + .maxstack 8 + IL_0000: nop + IL_0001: ret + } // end of method $TestFunction24::main@ + +} // end of class ''.$TestFunction24 + + +// ============================================================= + +// *********** DISASSEMBLY COMPLETE *********************** diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/Testfunction24.fs b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/Testfunction24.fs new file mode 100644 index 00000000000..eb297d2f636 --- /dev/null +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/Testfunction24.fs @@ -0,0 +1,32 @@ +open FSharp.NativeInterop +// Assume that the following class exists. + +type Point = { mutable x : int; mutable y : int } + +let pinObject() = + let point = { x = 1; y = 2 } + use p1 = fixed &point.x // note, fixed is a keyword and would be highlighted + NativePtr.get p1 0 + NativePtr.get p1 1 + +let pinRef() = + let point = ref 17 + use p1 = fixed &point.contents // note, fixed is a keyword and would be highlighted + NativePtr.read p1 + NativePtr.read p1 + +let pinArray1() = + let arr = [| 0.0; 1.5; 2.3; 3.4; 4.0; 5.9 |] + use p1 = fixed arr + NativePtr.get p1 0 + NativePtr.get p1 1 + +let pinArray2() = + let arr = [| 0.0; 1.5; 2.3; 3.4; 4.0; 5.9 |] + // You can initialize a pointer by using the address of a variable. + use p = fixed &arr.[0] + NativePtr.get p 0 + NativePtr.get p 1 + +let pinString() = + let str = "Hello World" + // The following assignment initializes p by using a string. + use pChar = fixed str + NativePtr.get pChar 0, NativePtr.get pChar 1 + diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/env.lst b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/env.lst index 8ffdad5d7fa..9196e88642c 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/env.lst +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/env.lst @@ -43,3 +43,4 @@ SOURCE=Testfunction22g.fs SCFLAGS="-g --test:EmitFeeFeeAs100001 --optimize-" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd TestFunction22g.exe" # TestFunction22g.fs SOURCE=Testfunction22h.fs SCFLAGS="-g --test:EmitFeeFeeAs100001 --optimize-" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd TestFunction22h.exe NetFx40" # TestFunction22h.fs - NetFx40 + SOURCE=TestFunction24.fs SCFLAGS="-g --optimize-" PEVER=/Exp_Fail COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd TestFunction24.exe NetFx40" # TestFunction24.fs - NetFx40 diff --git a/tests/fsharpqa/Source/CompilerOptions/fsc/help/help40.437.1033.bsl b/tests/fsharpqa/Source/CompilerOptions/fsc/help/help40.437.1033.bsl index b9cdeedccad..227de6e5682 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsc/help/help40.437.1033.bsl +++ b/tests/fsharpqa/Source/CompilerOptions/fsc/help/help40.437.1033.bsl @@ -50,9 +50,10 @@ Copyright (c) Microsoft Corporation. All Rights Reserved. - CODE GENERATION - --debug[+|-] Emit debug information (Short form: -g) --debug:{full|pdbonly|portable} Specify debugging type: full, portable, pdbonly. - ('full' is the default and enables attaching a - debugger to a running program. 'portable' is a - cross-platform format). + ('full' is the default if no debuggging type + specified and enables attaching a debugger to a + running program. 'portable' is a cross-platform + format). --optimize[+|-] Enable optimizations (Short form: -O) --tailcalls[+|-] Enable or disable tailcalls --crossoptimize[+|-] Enable or disable cross-module optimizations diff --git a/tests/fsharpqa/Source/CompilerOptions/fsi/exename/help40.437.1033.bsl b/tests/fsharpqa/Source/CompilerOptions/fsi/exename/help40.437.1033.bsl index a18d704a47a..3aaba1fffc8 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsi/exename/help40.437.1033.bsl +++ b/tests/fsharpqa/Source/CompilerOptions/fsi/exename/help40.437.1033.bsl @@ -13,9 +13,10 @@ Usage: fsharpi [script.fsx []] - CODE GENERATION - --debug[+|-] Emit debug information (Short form: -g) --debug:{full|pdbonly|portable} Specify debugging type: full, portable, pdbonly. - ('full' is the default and enables attaching a - debugger to a running program. 'portable' is a - cross-platform format). + ('pdbonly' is the default if no debuggging type + specified and enables attaching a debugger to a + running program. 'portable' is a cross-platform + format). --optimize[+|-] Enable optimizations (Short form: -O) --tailcalls[+|-] Enable or disable tailcalls --crossoptimize[+|-] Enable or disable cross-module optimizations diff --git a/tests/fsharpqa/Source/CompilerOptions/fsi/help/help-nologo.437.1033.bsl b/tests/fsharpqa/Source/CompilerOptions/fsi/help/help-nologo.437.1033.bsl index fef422e77b2..272f7d9eb65 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsi/help/help-nologo.437.1033.bsl +++ b/tests/fsharpqa/Source/CompilerOptions/fsi/help/help-nologo.437.1033.bsl @@ -13,9 +13,10 @@ Usage: fsi.exe [script.fsx []] - CODE GENERATION - --debug[+|-] Emit debug information (Short form: -g) --debug:{full|pdbonly|portable} Specify debugging type: full, portable, pdbonly. - ('full' is the default and enables attaching a - debugger to a running program. 'portable' is a - cross-platform format). + ('pdbonly' is the default if no debuggging type + specified and enables attaching a debugger to a + running program. 'portable' is a cross-platform + format). --optimize[+|-] Enable optimizations (Short form: -O) --tailcalls[+|-] Enable or disable tailcalls --crossoptimize[+|-] Enable or disable cross-module optimizations diff --git a/tests/fsharpqa/Source/CompilerOptions/fsi/help/help.437.1033.bsl b/tests/fsharpqa/Source/CompilerOptions/fsi/help/help.437.1033.bsl index 19560e30d6e..5afc1c8249d 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsi/help/help.437.1033.bsl +++ b/tests/fsharpqa/Source/CompilerOptions/fsi/help/help.437.1033.bsl @@ -15,9 +15,10 @@ Usage: fsi.exe [script.fsx []] - CODE GENERATION - --debug[+|-] Emit debug information (Short form: -g) --debug:{full|pdbonly|portable} Specify debugging type: full, portable, pdbonly. - ('full' is the default and enables attaching a - debugger to a running program. 'portable' is a - cross-platform format). + ('pdbonly' is the default if no debuggging type + specified and enables attaching a debugger to a + running program. 'portable' is a cross-platform + format). --optimize[+|-] Enable optimizations (Short form: -O) --tailcalls[+|-] Enable or disable tailcalls --crossoptimize[+|-] Enable or disable cross-module optimizations diff --git a/tests/fsharpqa/Source/CompilerOptions/fsi/help/help40-nologo.437.1033.bsl b/tests/fsharpqa/Source/CompilerOptions/fsi/help/help40-nologo.437.1033.bsl index 1f3c40955f3..3ffd8e94bdf 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsi/help/help40-nologo.437.1033.bsl +++ b/tests/fsharpqa/Source/CompilerOptions/fsi/help/help40-nologo.437.1033.bsl @@ -13,9 +13,10 @@ Usage: Fsi.exe [script.fsx []] - CODE GENERATION - --debug[+|-] Emit debug information (Short form: -g) --debug:{full|pdbonly|portable} Specify debugging type: full, portable, pdbonly. - ('full' is the default and enables attaching a - debugger to a running program. 'portable' is a - cross-platform format). + ('pdbonly' is the default if no debuggging type + specified and enables attaching a debugger to a + running program. 'portable' is a cross-platform + format). --optimize[+|-] Enable optimizations (Short form: -O) --tailcalls[+|-] Enable or disable tailcalls --crossoptimize[+|-] Enable or disable cross-module optimizations diff --git a/tests/fsharpqa/Source/CompilerOptions/fsi/help/help40.437.1033.bsl b/tests/fsharpqa/Source/CompilerOptions/fsi/help/help40.437.1033.bsl index 7863c44e924..722596ffd71 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsi/help/help40.437.1033.bsl +++ b/tests/fsharpqa/Source/CompilerOptions/fsi/help/help40.437.1033.bsl @@ -15,9 +15,10 @@ Usage: Fsi.exe [script.fsx []] - CODE GENERATION - --debug[+|-] Emit debug information (Short form: -g) --debug:{full|pdbonly|portable} Specify debugging type: full, portable, pdbonly. - ('full' is the default and enables attaching a - debugger to a running program. 'portable' is a - cross-platform format). + ('pdbonly' is the default if no debuggging type + specified and enables attaching a debugger to a + running program. 'portable' is a cross-platform + format). --optimize[+|-] Enable optimizations (Short form: -O) --tailcalls[+|-] Enable or disable tailcalls --crossoptimize[+|-] Enable or disable cross-module optimizations diff --git a/tests/fsharpqa/Source/Conformance/DeclarationElements/LetBindings/Basic/W_DoBindingsNotUnit01.fs b/tests/fsharpqa/Source/Conformance/DeclarationElements/LetBindings/Basic/W_DoBindingsNotUnit01.fs index f527a126c76..e703b6ac2a4 100644 --- a/tests/fsharpqa/Source/Conformance/DeclarationElements/LetBindings/Basic/W_DoBindingsNotUnit01.fs +++ b/tests/fsharpqa/Source/Conformance/DeclarationElements/LetBindings/Basic/W_DoBindingsNotUnit01.fs @@ -2,7 +2,7 @@ #light // Verify warning when 'do-bindings' do not return unit. -//This expression should have type 'unit', but has type 'int' +//The result of this expression is implicitly ignored let square x = x * x diff --git a/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in01.fs b/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in01.fs index 1f96f9e14f8..72abc807372 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in01.fs +++ b/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in01.fs @@ -5,7 +5,7 @@ // Eventually, we will deprecated them - and the specs will be updated. // //The value or constructor 'a' is not defined$ -//This expression should have type 'unit', but has type 'bool'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ module A = let a = 3 in a + 1 |> ignore;; a > 4;; diff --git a/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in02.fs b/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in02.fs index d49ef5d5bff..b3799eb1539 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in02.fs +++ b/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in02.fs @@ -4,7 +4,7 @@ // I'm adding these cases to make sure we do not accidentally change the behavior from version to version // Eventually, we will deprecated them - and the specs will be updated. // -//This expression should have type 'unit', but has type 'bool'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ // module B = diff --git a/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in03.fs b/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in03.fs index 41759f95d54..e0af19fb87c 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in03.fs +++ b/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in03.fs @@ -4,7 +4,7 @@ // I'm adding these cases to make sure we do not accidentally change the behavior from version to version // Eventually, we will deprecated them - and the specs will be updated. // -//This expression should have type 'unit', but has type 'bool'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ // module C = let a = 3 diff --git a/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in04.fs b/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in04.fs index 5899d4bbbd2..36e735c458e 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in04.fs +++ b/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in04.fs @@ -4,7 +4,7 @@ // I'm adding these cases to make sure we do not accidentally change the behavior from version to version // Eventually, we will deprecated them - and the specs will be updated. // -//This expression should have type 'unit', but has type 'bool'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ // module D = diff --git a/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in05.fs b/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in05.fs index 183ff1a0e89..68dad9c89db 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in05.fs +++ b/tests/fsharpqa/Source/Conformance/Expressions/BindingExpressions/Binding/in05.fs @@ -5,7 +5,7 @@ // Eventually, we will deprecated them - and the specs will be updated. //The type 'int' does not match the type 'unit'$ //Type mismatch\. Expecting a. ''a -> 'b' .but given a. ''a -> unit' .The type 'int' does not match the type 'unit'$ -//This expression should have type 'unit', but has type 'bool'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ module E = let a = 3 in a + 1 |> ignore diff --git a/tests/fsharpqa/Source/Conformance/Expressions/ControlFlowExpressions/TryFinally/W-TryFinallyNotUnit.fs b/tests/fsharpqa/Source/Conformance/Expressions/ControlFlowExpressions/TryFinally/W-TryFinallyNotUnit.fs index 516306e9269..bdb54bf3d7b 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/ControlFlowExpressions/TryFinally/W-TryFinallyNotUnit.fs +++ b/tests/fsharpqa/Source/Conformance/Expressions/ControlFlowExpressions/TryFinally/W-TryFinallyNotUnit.fs @@ -2,7 +2,7 @@ #light // Verify warning if a finally block does not return 'unit' -//This expression should have type 'unit', but has type 'bool' +//The result of this expression is implicitly ignored let x : int = try diff --git a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_WhereRequiresParens01.fs b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_WhereRequiresParens01.fs index d36c7227514..453173b9192 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_WhereRequiresParens01.fs +++ b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/QueryExpressions/E_WhereRequiresParens01.fs @@ -1,7 +1,7 @@ // #Conformance #DataExpressions #Query // Where expressions require parenthesis //'where' is not used correctly\. This is a custom operation in this query or computation expression\.$ -//This expression should have type 'unit', but has type 'bool'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ let query = query { for i in [1..10] do diff --git a/tests/fsharpqa/Source/Conformance/LexicalAnalysis/IdentifiersAndKeywords/E_ReservedIdentKeywords.fs b/tests/fsharpqa/Source/Conformance/LexicalAnalysis/IdentifiersAndKeywords/E_ReservedIdentKeywords.fs index 2c550ad3d3c..d1a63a0c45d 100644 --- a/tests/fsharpqa/Source/Conformance/LexicalAnalysis/IdentifiersAndKeywords/E_ReservedIdentKeywords.fs +++ b/tests/fsharpqa/Source/Conformance/LexicalAnalysis/IdentifiersAndKeywords/E_ReservedIdentKeywords.fs @@ -1,60 +1,58 @@ // #Regression #Conformance #LexicalAnalysis // Reserved identifiers and keywords // Also cover regression test for FSHARP1.0:5367 (keyword 'virtual') -let atomic = 10 + let break = 10 let checked = 10 let component = 10 let constraint = 10 -let constructor = 10 + let continue = 10 -let eager = 10 -let fixed = 10 + + let fori = 10 -let functor = 10 + let include = 10 -let method = 10 -let measure = 10 + + let mixin = 10 -let object = 10 + let parallel = 10 let params = 10 let process = 10 let protected = 10 let pure = 10 -let recursive = 10 + let sealed = 10 let tailcall = 10 let trait = 10 let virtual = 10 -let volatile = 10 -//The identifier 'atomic' is reserved for future use by F# + + //The identifier 'break' is reserved for future use by F# //The identifier 'checked' is reserved for future use by F# //The identifier 'component' is reserved for future use by F# //The identifier 'constraint' is reserved for future use by F# -//The identifier 'constructor' is reserved for future use by F# + //The identifier 'continue' is reserved for future use by F# -//The identifier 'eager' is reserved for future use by F# -//The identifier 'fixed' is reserved for future use by F# //The identifier 'fori' is reserved for future use by F# -//The identifier 'functor' is reserved for future use by F# + //The identifier 'include' is reserved for future use by F# -//The identifier 'method' is reserved for future use by F# -//The identifier 'measure' is reserved for future use by F# + + //The identifier 'mixin' is reserved for future use by F# -//The identifier 'object' is reserved for future use by F# + //The identifier 'parallel' is reserved for future use by F# //The identifier 'params' is reserved for future use by F# //The identifier 'process' is reserved for future use by F# //The identifier 'protected' is reserved for future use by F# //The identifier 'pure' is reserved for future use by F# -//The identifier 'recursive' is reserved for future use by F# + //The identifier 'sealed' is reserved for future use by F# //The identifier 'tailcall' is reserved for future use by F# //The identifier 'trait' is reserved for future use by F# //The identifier 'virtual' is reserved for future use by F# -//The identifier 'volatile' is reserved for future use by F# + diff --git a/tests/fsharpqa/Source/Conformance/LexicalAnalysis/IdentifiersAndKeywords/W_ReservedWord01.fs b/tests/fsharpqa/Source/Conformance/LexicalAnalysis/IdentifiersAndKeywords/W_ReservedWord01.fs index 8b3a8681950..070cfca18ff 100644 --- a/tests/fsharpqa/Source/Conformance/LexicalAnalysis/IdentifiersAndKeywords/W_ReservedWord01.fs +++ b/tests/fsharpqa/Source/Conformance/LexicalAnalysis/IdentifiersAndKeywords/W_ReservedWord01.fs @@ -3,8 +3,8 @@ // Verify warning when using a reserved identifier -//The identifier 'atomic' is reserved for future use by F# -let atomic = 1 + + exit 0 diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_byref_two_arguments_curried.fsx b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_byref_two_arguments_curried.fsx index 2f99a7564d3..e5ffef324c3 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_byref_two_arguments_curried.fsx +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_byref_two_arguments_curried.fsx @@ -2,6 +2,6 @@ // Regression test for FSHARP1.0:5580 // disallow curried byref parameters // Out arguments - curried -//Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition' or 'byref' arguments$ +//Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition', 'byref', 'CallerLineNumber', 'CallerMemberName', or 'CallerFilePath' arguments type Misc2() = static member M (foo : int byref) (bar : int byref) = foo <- 10 diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_optional_two_arguments_curried.fsx b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_optional_two_arguments_curried.fsx index 20786eb74ec..3aa8c622948 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_optional_two_arguments_curried.fsx +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_optional_two_arguments_curried.fsx @@ -2,6 +2,6 @@ // Regression test for FSHARP1.0:5580 // disallow curried byref parameters // optional arguments - curried -//Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition' or 'byref' arguments$ +//Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition', 'byref', 'CallerLineNumber', 'CallerMemberName', or 'CallerFilePath' arguments type Misc0() = static member M (?foo : int) (?bar : int) = 10 diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_out_two_arguments_curried.fsx b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_out_two_arguments_curried.fsx index 4f167735666..2f6cec8efca 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_out_two_arguments_curried.fsx +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_out_two_arguments_curried.fsx @@ -2,6 +2,6 @@ // Regression test for FSHARP1.0:5580 // disallow curried byref parameters // Out arguments - curried -//Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition' or 'byref' arguments$ +//Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition', 'byref', 'CallerLineNumber', 'CallerMemberName', or 'CallerFilePath' arguments type Misc2() = static member M ([] foo : int byref) ([] bar : int byref) = foo <- 10 diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_paramarray_two_arguments_curried.fsx b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_paramarray_two_arguments_curried.fsx index fea11eebf66..fb611d7bb1d 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_paramarray_two_arguments_curried.fsx +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/MemberDeclarations/E_paramarray_two_arguments_curried.fsx @@ -2,6 +2,6 @@ // Regression test for FSHARP1.0:5580 // disallow curried byref parameters // ParamArray arguments - non curried -//Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition' or 'byref' arguments$ +//Methods with curried arguments cannot declare 'out', 'ParamArray', 'optional', 'ReflectedDefinition', 'byref', 'CallerLineNumber', 'CallerMemberName', or 'CallerFilePath' arguments type Misc0() = static member M ([] args : string[]) ([] argc : int) = args.Length + argc diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/basic/E_ExtensionInNamespace01.fs b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/basic/E_ExtensionInNamespace01.fs index 9ac297509b4..642ce3025fa 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/basic/E_ExtensionInNamespace01.fs +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/basic/E_ExtensionInNamespace01.fs @@ -2,7 +2,7 @@ // Verify error associated with placing type extensions // inside namespaces. (They must only be placed in modules.) -//Namespaces cannot contain extension members except in the same file and namespace where the type is defined\. Consider using a module to hold declarations of extension members\.$ +//Namespaces cannot contain extension members except in the same file and namespace declaration group where the type is defined\. Consider using a module to hold declarations of extension members\.$ namespace System diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/optional/E_NotInModule.fs b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/optional/E_NotInModule.fs index bbaef6165b4..b8301f534b2 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/optional/E_NotInModule.fs +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/optional/E_NotInModule.fs @@ -1,6 +1,6 @@ // #Regression #Conformance #ObjectOrientedTypes #TypeExtensions // Verify that optional extension must be inside a module -//Namespaces cannot contain extension members except in the same file and namespace where the type is defined\. Consider using a module to hold declarations of extension members\.$ +//Namespaces cannot contain extension members except in the same file and namespace declaration group where the type is defined\. Consider using a module to hold declarations of extension members\.$ namespace NS type Lib with diff --git a/tests/fsharpqa/Source/Conformance/PatternMatching/Named/E_ActivePatternUnconstrained01.fs b/tests/fsharpqa/Source/Conformance/PatternMatching/Named/E_ActivePatternUnconstrained01.fs index 1f0a23ab75e..b930cbaba00 100644 --- a/tests/fsharpqa/Source/Conformance/PatternMatching/Named/E_ActivePatternUnconstrained01.fs +++ b/tests/fsharpqa/Source/Conformance/PatternMatching/Named/E_ActivePatternUnconstrained01.fs @@ -2,7 +2,7 @@ // Regression test for FSHARP1.0:5590 // This code used to compile, but fail peverification // Now, it just does not compile anymore telling the user to annotated it a bit. -//This expression should have type 'unit', but has type 'int'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ //Active pattern '\|A1\|A2\|A3\|' has a result type containing type variables that are not determined by the input\. The common cause is a when a result case is not mentioned, e\.g\. 'let \(\|A\|B\|\) \(x:int\) = A x'\. This can be fixed with a type constraint, e\.g\. 'let \(\|A\|B\|\) \(x:int\) : Choice = A x'$ let (|A1|A2|A3|) (inp:int) : Choice = printfn "hello" diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CSharpLib.cs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CSharpLib.cs new file mode 100644 index 00000000000..352115961c3 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CSharpLib.cs @@ -0,0 +1,49 @@ +using System; +using System.Reflection; +using System.Runtime.CompilerServices; + +namespace CSharpLib +{ + public class CallerInfoTest + { + public static int LineNumber([CallerLineNumber] int line = 777) + { + return line; + } + + public static string FilePath([CallerFilePath] string filePath = "dummy1") + { + return filePath; + } + + public static string MemberName([CallerMemberName] string memberName = "dummy1") + { + return memberName; + } + + public static Tuple AllInfo(int normalArg, [CallerFilePath] string filePath = "dummy2", [CallerLineNumber] int line = 778, [CallerMemberName] string memberName = "dummy3") + { + return new Tuple(filePath, line, memberName); + } + } + + public class MyCallerInfoAttribute : Attribute + { + public int LineNumber { get; set; } + + public MyCallerInfoAttribute([CallerLineNumber] int lineNumber = -1) + { + LineNumber = lineNumber; + } + } + + public class MyCallerMemberNameAttribute : Attribute + { + public string MemberName { get; set; } + + public MyCallerMemberNameAttribute([CallerMemberName] string member = "dflt") + { + MemberName = member; + } + } +} \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerFilePath.fs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerFilePath.fs new file mode 100644 index 00000000000..c44f97e4d53 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerFilePath.fs @@ -0,0 +1,68 @@ +namespace Test + +open System.Runtime.CompilerServices +open CSharpLib + +type MyTy([] ?p0 : string) = + let mutable p = p0 + + member x.Path with get() = p + + static member GetCallerFilePath([] ?path : string) = + path + +module Program = + let doubleSeparator = "##".Replace('#', System.IO.Path.DirectorySeparatorChar) + let sameDirectory = "#.#".Replace('#', System.IO.Path.DirectorySeparatorChar) + let parentDirectory = ".." + let matchesPath (path : string) (s : string) = + s.EndsWith(path.Replace('#', System.IO.Path.DirectorySeparatorChar)) + && not (s.Contains(doubleSeparator)) + && not (s.Contains(sameDirectory)) + && not (s.Contains(parentDirectory)) + + + [] + let main (_:string[]) = + let o = MyTy() + let o1 = MyTy("42") + + match o.Path with + | Some(path) when matchesPath "Conformance#SpecialAttributesAndTypes#Imported#CallerInfo#CallerFilePath.fs" path -> () + | x -> failwithf "Unexpected: %A" x + + match o1.Path with + | Some(path) when matchesPath "42" path -> () + | x -> failwithf "Unexpected: %A" x + + match MyTy.GetCallerFilePath() with + | Some(path) when matchesPath "Conformance#SpecialAttributesAndTypes#Imported#CallerInfo#CallerFilePath.fs" path -> () + | x -> failwithf "Unexpected: %A" x + + match MyTy.GetCallerFilePath("42") with + | Some("42") -> () + | x -> failwithf "Unexpected: %A" x + + match CallerInfoTest.FilePath() with + | path when matchesPath "Conformance#SpecialAttributesAndTypes#Imported#CallerInfo#CallerFilePath.fs" path -> () + | x -> failwithf "Unexpected: %A" x + + match CallerInfoTest.FilePath("xyz") with + | "xyz" -> () + | x -> failwithf "Unexpected: %A" x + + match CallerInfoTest.AllInfo(21) with + | (path, _, _) when matchesPath "Conformance#SpecialAttributesAndTypes#Imported#CallerInfo#CallerFilePath.fs" path -> () + | x -> failwithf "Unexpected C# result with multiple parameter types: %A" x + +# 345 "qwerty1" + match CallerInfoTest.AllInfo(123) with + | (path, _, _) when matchesPath "Conformance#SpecialAttributesAndTypes#Imported#CallerInfo#qwerty1" path -> () + | x -> failwithf "Unexpected C# result with multiple parameter types: %A" x + +# 456 "qwerty2" + match CallerInfoTest.AllInfo(123) with + | (path, _, _) when matchesPath "Conformance#SpecialAttributesAndTypes#Imported#CallerInfo#qwerty2" path -> () + | x -> failwithf "Unexpected C# result with multiple parameter types: %A" x + + 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerInfoAndComputationExpression.fs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerInfoAndComputationExpression.fs new file mode 100644 index 00000000000..8c28f251fc8 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerInfoAndComputationExpression.fs @@ -0,0 +1,27 @@ +namespace Test + +open System.Runtime.CompilerServices + +type Builder() = + member self.Bind(x, f, [] ?line : int) = + (f x, line) + + member self.Return(x, [] ?line : int) = + (x, line) + +module Program = + let builder = Builder() + + [] + let main (_:string[]) = + let result = + builder { + let! x = 1 + let! y = 2 + return x + y + } + + if result <> (((3, Some 21), Some 20), Some 19) then + failwith "Unexpected F# CallerLineNumber" + + 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerInfoAndQuotiation.fs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerInfoAndQuotiation.fs new file mode 100644 index 00000000000..cd06b29d97f --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerInfoAndQuotiation.fs @@ -0,0 +1,30 @@ +namespace Test + +open System.Runtime.CompilerServices +open Microsoft.FSharp.Quotations +open Microsoft.FSharp.Quotations.Patterns + +type MyTy() = + static member GetCallerLineNumber([] ?line : int) = + line + +module Program = + [] + let main (_:string[]) = + let expr = <@ MyTy.GetCallerLineNumber () @> + + match expr with + | Call(None, methodInfo, e::[]) + when methodInfo.Name = "GetCallerLineNumber" -> + match e with + | NewUnionCase(uci, value::[]) + when uci.Name = "Some" -> + match value with + | Value(obj, ty) when ty = typeof && obj :?> int = 14 -> () + | _ -> failwith "Unexpected F# CallerLineNumber" + | _ -> + failwith "Unexpected F# CallerLineNumber" + | _ -> + failwith "Unexpected F# CallerLineNumber" + + 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerLineNumber.fs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerLineNumber.fs new file mode 100644 index 00000000000..4692802480b --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerLineNumber.fs @@ -0,0 +1,49 @@ +namespace Test + +open System.Runtime.CompilerServices +open CSharpLib +[] +type MyTy() = + static member GetCallerLineNumber([] ?line : int) = + line + +module Program = + [] + let main (_:string[]) = + if MyTy.GetCallerLineNumber() <> Some(13) then + failwith "Unexpected F# CallerLineNumber" + + if MyTy.GetCallerLineNumber(42) <> Some(42) then + failwith "Unexpected F# CallerLineNumber" + + if CallerInfoTest.LineNumber() <> 19 then + failwith "Unexpected C# CallerLineNumber" + + if CallerInfoTest.LineNumber(88) <> 88 then + failwith "Unexpected C# CallerLineNumber" + + match CallerInfoTest.AllInfo(21) with + | (_, 25, _) -> () + | x -> failwithf "Unexpected C# result with multiple parameter types: %A" x + + if (typeof.GetCustomAttributes(typeof, false).[0] :?> MyCallerInfoAttribute).LineNumber <> 5 then + failwith "Unexpected C# MyCallerInfoAttribute" + + let getCallerLineNumber = CallerInfoTest.LineNumber + + if () |> CallerInfoTest.LineNumber <> 34 then + failwith "Unexpected C# CallerLineNumber" + + if getCallerLineNumber () <> 32 then + failwith "Unexpected C# CallerLineNumber" + +# 345 "qwerty" + match CallerInfoTest.AllInfo(123) with + | (_, 345, _) -> () + | x -> failwithf "Unexpected C# result with multiple parameter types: %A" x +# 456 "qwerty" + match CallerInfoTest.AllInfo(123) with + | (_, 456, _) -> () + | x -> failwithf "Unexpected C# result with multiple parameter types: %A" x + + 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerMemberName.fs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerMemberName.fs new file mode 100644 index 00000000000..b9bb974c8bd --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/CallerMemberName.fs @@ -0,0 +1,175 @@ +namespace Test + +open System +open System.Runtime.CompilerServices +open System.Reflection +open CSharpLib + +[] +do + () + +[] +type MyTy() = + let functionVal = MyTy.GetCallerMemberName + let typeLetValue = MyTy.GetCallerMemberName() + let typeLetFunc (i:int) = i, MyTy.GetCallerMemberName() + let typeLetFuncNested () = + let nestedFunc () = MyTy.GetCallerMemberName() + nestedFunc () + do + MyTy.Check(MyTy.GetCallerMemberName(), Some(".ctor"), "primary ctor") + static do + MyTy.Check(MyTy.GetCallerMemberName(), Some(".cctor"), "static ctor") + + new(i : int) = + MyTy.Check(MyTy.GetCallerMemberName(), Some(".ctor"), ".NET ctor") + MyTy() + + member __.Item + with get(i:int) = MyTy.GetCallerMemberName() + and set(i:int) (v:string option) = + MyTy.Check(MyTy.GetCallerMemberName(), Some("Item"), "index setter") + + member __.CheckMembers() = + MyTy.Check(MyTy.GetCallerMemberName(), Some("CheckMembers"), ".NET method") + MyTy.Check(typeLetValue, Some("typeLetValue"), "type let value") + MyTy.Check(typeLetFunc 2 |> snd, Some("typeLetFunc"), "type let func") + MyTy.Check((typeLetFuncNested ()) , Some("typeLetFuncNested"), "type let func nested") + MyTy.Check(__.GetCallerMemberNameProperty1, Some("GetCallerMemberNameProperty1@"), "auto property getter") + MyTy.Check(MyTy.GetCallerMemberNameProperty, Some("GetCallerMemberNameProperty"), "property getter") + MyTy.GetCallerMemberNameProperty <- Some("test") + MyTy.Check(__.[10], Some("Item"), "indexer getter") + __.[10] <- Some("test") + + let result = + [1..10] + |> List.map (fun i -> MyTy.GetCallerMemberName()) + |> List.head + MyTy.Check(result, Some("CheckMembers"), "lambda") + MyTy.Check(functionVal (), Some("functionVal"), "functionVal") + () + + static member GetCallerMemberName([] ?memberName : string) = + memberName + + static member Check(actual : string option, expected : string option, message) = + printfn "%A" actual + if actual <> expected then + failwith message + + static member GetCallerMemberNameProperty + with get () = MyTy.GetCallerMemberName() + and set (v : string option) = + MyTy.Check(MyTy.GetCallerMemberName(), Some("GetCallerMemberNameProperty"), "property setter") + + member val GetCallerMemberNameProperty1 = MyTy.GetCallerMemberName() with get, set + +[] +type MyStruct = + val A : int + new(a : int) = + { A = a } + then + MyTy.Check(MyTy.GetCallerMemberName(), Some(".ctor"), "struct ctor") + +[] +type Extensions = + [] + static member DotNetExtensionMeth(instance : System.DateTime) = + MyTy.GetCallerMemberName() + +type IMyInterface = + abstract member MyInterfaceMethod : unit -> string option + +[] +type MyAbstractTy() = + abstract MyAbstractMethod : unit -> string option + +module Program = + type System.String with + member __.StringExtensionMeth() = + MyTy.Check(MyTy.GetCallerMemberName(),Some("StringExtensionMeth"), "extension method") + 1 + member __.StringExtensionProp = + MyTy.Check(MyTy.GetCallerMemberName(), Some("StringExtensionProp"), "extension property") + 2 + + let callerInfoAsFunc = MyTy.GetCallerMemberName + let rebindFunc = callerInfoAsFunc + let moduleLetVal = MyTy.GetCallerMemberName() + let moduleFunc (i : int) = i, MyTy.GetCallerMemberName() + let moduleFuncNested i = + let nestedFunc j = + (j + 1),MyTy.GetCallerMemberName() + nestedFunc i + let ``backtick value name`` = MyTy.GetCallerMemberName() + let (+++) a b = + (a+b, MyTy.GetCallerMemberName()) + + MyTy.Check(MyTy.GetCallerMemberName(), Some(".cctor"), "module cctor") + + [] + let main (_:string[]) = + MyTy.Check(MyTy.GetCallerMemberName(), Some("main"), "main") + + MyTy.Check(MyTy.GetCallerMemberName("foo"), Some("foo"), "passed value") + + MyTy.Check(moduleLetVal, Some("moduleLetVal"), "module let value") + + MyTy.Check(``backtick value name``, Some("backtick value name"), "backtick identifier") + + MyTy.Check(moduleFunc 3 |> snd, Some("moduleFunc"), "module func") + + MyTy.Check(moduleFuncNested 10 |> snd, Some("moduleFuncNested"), "module func nested") + + let inst = MyTy() + inst.CheckMembers() + let inst2 = MyTy(2) + inst2.CheckMembers() + + let v = CallerInfoTest.MemberName() + MyTy.Check(Some(v), Some("main"), "C# main") + + MyTy.Check(Some(CallerInfoTest.MemberName("foo")), Some("foo"), "C# passed value") + + match CallerInfoTest.AllInfo(21) with + | (_, _, "main") -> () + | x -> failwithf "Unexpected C# result with multiple parameter types: %A" x + + MyTy.Check(() |> callerInfoAsFunc, Some("callerInfoAsFunc"), "method as function value 1") + MyTy.Check(() |> rebindFunc, Some("callerInfoAsFunc"), "method as function value 2") + + let typeAttr = typeof.GetCustomAttributes(typeof, false).[0] :?> MyCallerMemberNameAttribute + MyTy.Check(Some(typeAttr.MemberName), Some("dflt"), "attribute on type") + + let asmAttr = Assembly.GetExecutingAssembly().GetCustomAttributes(typeof, false).[0] :?> MyCallerMemberNameAttribute + MyTy.Check(Some(asmAttr.MemberName), Some("dflt"), "attribute on asm") + + let s = "123" + let s1 = s.StringExtensionMeth() + let s2 = s.StringExtensionProp + + let dt = System.DateTime.Now + MyTy.Check(dt.DotNetExtensionMeth(), Some("DotNetExtensionMeth"), ".NET extension method") + + let strct = MyStruct(10) + + MyTy.Check(1 +++ 2 |> snd, Some("op_PlusPlusPlus"), "operator") + + let obj = { new IMyInterface with + member this.MyInterfaceMethod() = MyTy.GetCallerMemberName() } + MyTy.Check(obj.MyInterfaceMethod(), Some("MyInterfaceMethod"), "Object expression from interface") + + let obj1 = { new MyAbstractTy() with member x.MyAbstractMethod() = MyTy.GetCallerMemberName() } + MyTy.Check(obj1.MyAbstractMethod(), Some("MyAbstractMethod"), "Object expression from abstract type") + + let asyncVal = async { return MyTy.GetCallerMemberName() } |> Async.RunSynchronously + MyTy.Check(asyncVal, Some("main"), "Async computation expression value") + + let anonymousLambda = fun () -> MyTy.GetCallerMemberName() + MyTy.Check(anonymousLambda(), Some("main"), "Anonymous lambda") + + let delegateVal = new Func(fun () -> MyTy.GetCallerMemberName()) + MyTy.Check(delegateVal.Invoke(), Some("main"), "Delegate value") + 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_CallerFilePath.fs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_CallerFilePath.fs new file mode 100644 index 00000000000..d6e160d39af --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_CallerFilePath.fs @@ -0,0 +1,16 @@ +//'CallerFilePath' must be applied to an argument of type 'string', but has been applied to an argument of type 'int' +//'CallerFilePath' can only be applied to optional arguments +//'CallerFilePath' can only be applied to optional arguments +namespace Test + +open System.Runtime.CompilerServices + +type MyTy() = + static member GetCallerFilePathNotString([] ?path : int) = + path + + static member GetCallerFilePathNotOptional([] path : string) = + path + + static member GetCallerFilePathNotOptional([] path : string option) = + path \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_CallerLineNumber.fs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_CallerLineNumber.fs new file mode 100644 index 00000000000..1d66da69961 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_CallerLineNumber.fs @@ -0,0 +1,16 @@ +//'CallerLineNumber' must be applied to an argument of type 'int', but has been applied to an argument of type 'string' +//'CallerLineNumber' can only be applied to optional arguments +//'CallerLineNumber' can only be applied to optional arguments +namespace Test + +open System.Runtime.CompilerServices + +type MyTy() = + static member GetCallerLineNumberNotInt([] ?line : string) = + line + + static member GetCallerLineNumberNotOptional([] line : int) = + line + + static member GetCallerLineNumberNotOptional([] line : int option) = + line \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_CallerMemberName.fs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_CallerMemberName.fs new file mode 100644 index 00000000000..9749e1e1508 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_CallerMemberName.fs @@ -0,0 +1,16 @@ +//'CallerMemberName' must be applied to an argument of type 'string', but has been applied to an argument of type 'int' +//'CallerMemberName' can only be applied to optional arguments +//'CallerMemberName' can only be applied to optional arguments +namespace Test + +open System.Runtime.CompilerServices + +type MyTy() = + static member GetCallerMemberNameNotString([] ?name : int) = + name + + static member GetCallerMemberNameNotOptional([] name : string) = + name + + static member GetCallerMemberNameNotOptional([] name : string option) = + name \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_MultipleAttrs.fs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_MultipleAttrs.fs new file mode 100644 index 00000000000..fda49ca239f --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/E_MultipleAttrs.fs @@ -0,0 +1,21 @@ +//'CallerFilePath' must be applied to an argument of type 'string', but has been applied to an argument of type 'int' +//'CallerFilePath' must be applied to an argument of type 'string', but has been applied to an argument of type 'int' +//'CallerLineNumber' must be applied to an argument of type 'int', but has been applied to an argument of type 'string' +//'CallerLineNumber' must be applied to an argument of type 'int', but has been applied to an argument of type 'string' + +namespace Test + +open System.Runtime.CompilerServices + +type MyTy() = + static member A([] [] ?x : int) = + x + + static member B([] [] ?x : int) = + x + + static member C([] [] ?x : string) = + x + + static member D([] [] ?x : string) = + x diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/ViaInteractive.fsx b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/ViaInteractive.fsx new file mode 100644 index 00000000000..8a9e9928e4e --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/ViaInteractive.fsx @@ -0,0 +1,30 @@ +open System.Runtime.CompilerServices +open CSharpLib + +type MyTy() = + static member GetCallerFilePath([] ?path : string) = + path + static member GetCallerLineNumber([] ?line : int) = + line + +let matchesPath path (s : string) = + s.EndsWith(path) + && not (s.Contains("\\\\")) + && not (path.Contains("\\.\\")) + && not (path.Contains("\\..\\")) + +let scriptName = if Array.contains "--exec" (System.Environment.GetCommandLineArgs()) then "ViaInteractive.fsx" else "stdin" +let checkPath = sprintf "Conformance\\SpecialAttributesAndTypes\\Imported\\CallerInfo\\%s" scriptName + +match MyTy.GetCallerFilePath() with +| Some(path) when matchesPath checkPath path -> () +| x -> failwithf "Unexpected: %A" x + +if MyTy.GetCallerLineNumber() <> Some(23) then + failwith "Unexpected F# CallerLineNumber" + +match CallerInfoTest.AllInfo(21) with +| (path, 26, ".cctor") when matchesPath checkPath path -> () +| x -> failwithf "Unexpected C# result with multiple parameter types: %A" x + +#q \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/W_CallerMemberName.fs b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/W_CallerMemberName.fs new file mode 100644 index 00000000000..4838de65680 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/W_CallerMemberName.fs @@ -0,0 +1,8 @@ +//The CallerMemberNameAttribute applied to parameter 'name' will have no effect. It is overridden by the CallerFilePathAttribute. +namespace Test + +open System.Runtime.CompilerServices + +type MyTy() = + static member GetCallerMemberName([] ?name : string) = + name \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/env.lst b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/env.lst new file mode 100644 index 00000000000..46d8cb48635 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/SpecialAttributesAndTypes/Imported/CallerInfo/env.lst @@ -0,0 +1,12 @@ + SOURCE=CallerLineNumber.fs SCFLAGS="-r CSharpLib.dll --test:ErrorRanges" PRECMD="\$CSC_PIPE /t:library CSharpLib.cs" # CallerLineNumber.fs + SOURCE=CallerFilePath.fs SCFLAGS="-r CSharpLib.dll --test:ErrorRanges" PRECMD="\$CSC_PIPE /t:library CSharpLib.cs" # CallerFilePath.fs + SOURCE=CallerMemberName.fs SCFLAGS="-r CSharpLib.dll --test:ErrorRanges" PRECMD="\$CSC_PIPE /t:library CSharpLib.cs" # CallerMemberName.fs + SOURCE=E_CallerLineNumber.fs SCFLAGS="--test:ErrorRanges" # E_CallerLineNumber.fs + SOURCE=E_CallerFilePath.fs SCFLAGS="--test:ErrorRanges" # E_CallerFilePath.fs + SOURCE=E_CallerMemberName.fs SCFLAGS="--test:ErrorRanges" # E_CallerMemberName.fs + SOURCE=E_MultipleAttrs.fs SCFLAGS="--test:ErrorRanges" # E_MultipleAttrs.fs + SOURCE=W_CallerMemberName.fs SCFLAGS="--test:ErrorRanges" # W_CallerMemberName.fs + SOURCE=ViaInteractive.fsx SCFLAGS="--test:ErrorRanges -r CSharpLib.dll" PRECMD="\$CSC_PIPE /t:library CSharpLib.cs" FSIMODE=EXEC COMPILE_ONLY=1 # ViaInteractive.fsx - exec + SOURCE=ViaInteractive.fsx SCFLAGS="--test:ErrorRanges -r CSharpLib.dll" PRECMD="\$CSC_PIPE /t:library CSharpLib.cs" FSIMODE=PIPE COMPILE_ONLY=1 # ViaInteractive.fsx - pipe + SOURCE=CallerInfoAndQuotiation.fs SCFLAGS="-r CSharpLib.dll --test:ErrorRanges" PRECMD="\$CSC_PIPE /t:library CSharpLib.cs" # CallerInfoAndQuotiation.fs + SOURCE=CallerInfoAndComputationExpression.fs SCFLAGS="-r CSharpLib.dll --test:ErrorRanges" PRECMD="\$CSC_PIPE /t:library CSharpLib.cs" # CallerInfoAndComputationExpression.fs diff --git a/tests/fsharpqa/Source/Diagnostics/General/W_Multiline02.fs b/tests/fsharpqa/Source/Diagnostics/General/W_Multiline02.fs index cac6c4ad929..b68027a1693 100644 --- a/tests/fsharpqa/Source/Diagnostics/General/W_Multiline02.fs +++ b/tests/fsharpqa/Source/Diagnostics/General/W_Multiline02.fs @@ -1,7 +1,7 @@ // #Regression #Diagnostics // Regression test for FSHARP1.0:3596 // Make sure that error spans correctly across multiple lines -//This expression should have type 'unit' +//The result of this expression is implicitly ignored #nowarn "988" let f g x = g x diff --git a/tests/fsharpqa/Source/Diagnostics/NONTERM/quoteExpr01.fs b/tests/fsharpqa/Source/Diagnostics/NONTERM/quoteExpr01.fs index c402ba1b347..f6f6443df63 100644 --- a/tests/fsharpqa/Source/Diagnostics/NONTERM/quoteExpr01.fs +++ b/tests/fsharpqa/Source/Diagnostics/NONTERM/quoteExpr01.fs @@ -1,5 +1,5 @@ // #Regression #Diagnostics // Regression test for FSHARP1.0:2391, FSHARP1.0:1479 -//This expression should have type 'unit', but has type 'seq.Quotations.Var.' +//The result of this expression is implicitly ignored #light "off" <@@ 1 @@>.GetFreeVars() diff --git a/tests/fsharpqa/Source/Diagnostics/async/MissingIgnore.fs b/tests/fsharpqa/Source/Diagnostics/async/MissingIgnore.fs index 9e3adbb5d47..3fe0919320d 100644 --- a/tests/fsharpqa/Source/Diagnostics/async/MissingIgnore.fs +++ b/tests/fsharpqa/Source/Diagnostics/async/MissingIgnore.fs @@ -1,5 +1,5 @@ // #Regression #Diagnostics #Async // Regression tests for FSHARP1.0:4394 -//This expression should have type 'unit', but has type 'int'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ async { 1; return 2 } |> ignore diff --git a/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop01.fs b/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop01.fs index 888b8f9e104..4dd57691e8d 100644 --- a/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop01.fs +++ b/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop01.fs @@ -1,5 +1,5 @@ // #Regression #Diagnostics #Async // Regression tests for FSHARP1.0:4394 // common mistake: forgetting the return! For a loop -//This expression should have type 'unit', but has type 'Async<'a>'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ let rec loop() = async { let x = 1 in loop() } diff --git a/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop02.fs b/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop02.fs index af12902b2a6..a9bb89c9dac 100644 --- a/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop02.fs +++ b/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop02.fs @@ -1,5 +1,5 @@ // #Regression #Diagnostics #Async // Regression tests for FSHARP1.0:4394 // common mistake: forgetting the return! For a loop -//This expression should have type 'unit', but has type 'Async<'a>'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ let rec loop() = async { loop() } diff --git a/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop03.fs b/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop03.fs index e612c237631..dfba108aac0 100644 --- a/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop03.fs +++ b/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop03.fs @@ -1,6 +1,6 @@ // #Regression #Diagnostics #Async // Regression tests for FSHARP1.0:4394 // common mistake: forgetting the return! For a loop -//This expression should have type 'unit', but has type 'Async<'a>'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ //This expression was expected to have type. 'Async<'a>' .but here has type. 'unit' let rec loop2() = async.Delay(fun () -> loop2(); ()); diff --git a/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop04.fs b/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop04.fs index d12252d42c8..b86efb67132 100644 --- a/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop04.fs +++ b/tests/fsharpqa/Source/Diagnostics/async/MissingReturnBangForLoop04.fs @@ -1,7 +1,7 @@ // #Regression #Diagnostics #Async // Regression tests for FSHARP1.0:4394 // common mistake: forgetting the return! For a loop -//This expression should have type 'unit', but has type 'Async<'a>'\. Use 'ignore' to discard the result of the expression, or 'let' to bind the result to a name\.$ +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ //This expression was expected to have type. 'Async<'a>' .but here has type. 'unit' // Note: interestingly, this looks much better if a method call is not used let delay x = async.Delay x diff --git a/tests/fsharpqa/Source/Misc/Parsing02.fs b/tests/fsharpqa/Source/Misc/Parsing02.fs index d4db9a719bc..9a17369e870 100644 --- a/tests/fsharpqa/Source/Misc/Parsing02.fs +++ b/tests/fsharpqa/Source/Misc/Parsing02.fs @@ -1,10 +1,10 @@ // #Regression #Misc // Verify warnings associated with top level expressions getting discarded -//This expression should have type 'unit', but has type '\( \^a -> unit\) \* int' -//This expression should have type 'unit', but has type '\('a \[\] -> unit \[\]\) \* string \[\]' +//The result of this expression is implicitly ignored +//The result of this expression is implicitly ignored -// Note the comma between printf "%A", this results in a tuple expr which probabaly wasn't intended. +// Note the comma between printf "%A", this results in a tuple expr which probably wasn't intended. let arr = [|"Foo"; "Bar"|] printf "%d", arr.Length diff --git a/tests/fsharpqa/Source/Optimizations/Inlining/Match01.il.bsl b/tests/fsharpqa/Source/Optimizations/Inlining/Match01.il.bsl index ddfd9dfcac1..523f7efed86 100644 Binary files a/tests/fsharpqa/Source/Optimizations/Inlining/Match01.il.bsl and b/tests/fsharpqa/Source/Optimizations/Inlining/Match01.il.bsl differ diff --git a/tests/fsharpqa/Source/Optimizations/Inlining/StructUnion01.fs b/tests/fsharpqa/Source/Optimizations/Inlining/StructUnion01.fs new file mode 100644 index 00000000000..d3e41ff4788 --- /dev/null +++ b/tests/fsharpqa/Source/Optimizations/Inlining/StructUnion01.fs @@ -0,0 +1,39 @@ +// #NoMono #CodeGen #Optimizations +module StructUnion01 + +[] +type U = U of int * int + +let g1 (U(a,b)) = a + b + +let g2 u = + let (U(a,b)) = u + a + b + +let g3 (x:U) = + match x with + | U(3,a) -> a + | U(a,b) -> a + b + +let g4 (x:U) (y: U) = + match x,y with + | U(3,a), U(5,b) -> a + b + | U(a,b), U(c,d) -> a + b + c + d + +let f1 (x:U byref) = + let (U(a,b)) = x + a + b + +let f2 (x:U byref) = + match x with + | U(a,b) -> a + b + +let f3 (x:U byref) = + match x with + | U(3,a) -> a + | U(a,b) -> a + b + +let f4 (x:U byref) (y: U byref) = + match x,y with + | U(3,a), U(5,b) -> a + b + | U(a,b), U(c,d) -> a + b + c + d diff --git a/tests/fsharpqa/Source/Optimizations/Inlining/StructUnion01.il.bsl b/tests/fsharpqa/Source/Optimizations/Inlining/StructUnion01.il.bsl new file mode 100644 index 00000000000..95df244b59b --- /dev/null +++ b/tests/fsharpqa/Source/Optimizations/Inlining/StructUnion01.il.bsl @@ -0,0 +1,725 @@ + +// Microsoft (R) .NET Framework IL Disassembler. Version 4.6.1055.0 +// Copyright (c) Microsoft Corporation. All rights reserved. + + + +// Metadata version: v4.0.30319 +.assembly extern mscorlib +{ + .publickeytoken = (B7 7A 5C 56 19 34 E0 89 ) // .z\V.4.. + .ver 4:0:0:0 +} +.assembly extern FSharp.Core +{ + .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: + .ver 4:4:1:0 +} +.assembly StructUnion01 +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.FSharpInterfaceDataVersionAttribute::.ctor(int32, + int32, + int32) = ( 01 00 02 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + .hash algorithm 0x00008004 + .ver 0:0:0:0 +} +.mresource public FSharpSignatureData.StructUnion01 +{ + // Offset: 0x00000000 Length: 0x0000088A +} +.mresource public FSharpOptimizationData.StructUnion01 +{ + // Offset: 0x00000890 Length: 0x00000421 +} +.module StructUnion01.dll +// MVID: {576332E3-D3E9-6B24-A745-0383E3326357} +.imagebase 0x00400000 +.file alignment 0x00000200 +.stackreserve 0x00100000 +.subsystem 0x0003 // WINDOWS_CUI +.corflags 0x00000001 // ILONLY +// Image base: 0x007C0000 + + +// =============== CLASS MEMBERS DECLARATION =================== + +.class public abstract auto ansi sealed StructUnion01 + extends [mscorlib]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto autochar serializable sealed nested public beforefieldinit U + extends [mscorlib]System.ValueType + implements class [mscorlib]System.IEquatable`1, + [mscorlib]System.Collections.IStructuralEquatable, + class [mscorlib]System.IComparable`1, + [mscorlib]System.IComparable, + [mscorlib]System.Collections.IStructuralComparable + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.StructAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl + 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) + .field assembly int32 item1 + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .field assembly int32 item2 + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method public static valuetype StructUnion01/U + NewU(int32 item1, + int32 item2) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) + // Code size 8 (0x8) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: newobj instance void StructUnion01/U::.ctor(int32, + int32) + IL_0007: ret + } // end of method U::NewU + + .method assembly specialname rtspecialname + instance void .ctor(int32 item1, + int32 item2) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 15 (0xf) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: stfld int32 StructUnion01/U::item1 + IL_0007: ldarg.0 + IL_0008: ldarg.2 + IL_0009: stfld int32 StructUnion01/U::item2 + IL_000e: ret + } // end of method U::.ctor + + .method public hidebysig instance int32 + get_Item1() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 StructUnion01/U::item1 + IL_0006: ret + } // end of method U::get_Item1 + + .method public hidebysig instance int32 + get_Item2() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 StructUnion01/U::item2 + IL_0006: ret + } // end of method U::get_Item2 + + .method public hidebysig instance int32 + get_Tag() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 4 (0x4) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: pop + IL_0002: ldc.i4.0 + IL_0003: ret + } // end of method U::get_Tag + + .method assembly hidebysig specialname + instance object __DebugDisplay() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 27 (0x1b) + .maxstack 8 + IL_0000: ldstr "%+0.8A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: ldobj StructUnion01/U + IL_0015: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_001a: ret + } // end of method U::__DebugDisplay + + .method public hidebysig virtual final + instance int32 CompareTo(valuetype StructUnion01/U obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 77 (0x4d) + .maxstack 4 + .locals init (int32 V_0, + class [mscorlib]System.Collections.IComparer V_1, + int32 V_2, + int32 V_3) + IL_0000: ldarg.0 + IL_0001: pop + IL_0002: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() + IL_0007: stloc.1 + IL_0008: ldarg.0 + IL_0009: ldfld int32 StructUnion01/U::item1 + IL_000e: stloc.2 + IL_000f: ldarg.1 + IL_0010: ldfld int32 StructUnion01/U::item1 + IL_0015: stloc.3 + IL_0016: ldloc.2 + IL_0017: ldloc.3 + IL_0018: bge.s IL_001d + + IL_001a: ldc.i4.m1 + IL_001b: br.s IL_0021 + + IL_001d: ldloc.2 + IL_001e: ldloc.3 + IL_001f: cgt + IL_0021: stloc.0 + IL_0022: ldloc.0 + IL_0023: ldc.i4.0 + IL_0024: bge.s IL_0028 + + IL_0026: ldloc.0 + IL_0027: ret + + IL_0028: ldloc.0 + IL_0029: ldc.i4.0 + IL_002a: ble.s IL_002e + + IL_002c: ldloc.0 + IL_002d: ret + + IL_002e: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() + IL_0033: stloc.1 + IL_0034: ldarg.0 + IL_0035: ldfld int32 StructUnion01/U::item2 + IL_003a: stloc.2 + IL_003b: ldarg.1 + IL_003c: ldfld int32 StructUnion01/U::item2 + IL_0041: stloc.3 + IL_0042: ldloc.2 + IL_0043: ldloc.3 + IL_0044: bge.s IL_0048 + + IL_0046: ldc.i4.m1 + IL_0047: ret + + IL_0048: ldloc.2 + IL_0049: ldloc.3 + IL_004a: cgt + IL_004c: ret + } // end of method U::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: unbox.any StructUnion01/U + IL_0007: call instance int32 StructUnion01/U::CompareTo(valuetype StructUnion01/U) + IL_000c: ret + } // end of method U::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj, + class [mscorlib]System.Collections.IComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 81 (0x51) + .maxstack 4 + .locals init (valuetype StructUnion01/U V_0, + valuetype StructUnion01/U& V_1, + int32 V_2, + int32 V_3, + int32 V_4) + IL_0000: ldarg.1 + IL_0001: unbox.any StructUnion01/U + IL_0006: stloc.0 + IL_0007: ldloca.s V_0 + IL_0009: stloc.1 + IL_000a: ldarg.0 + IL_000b: pop + IL_000c: ldarg.0 + IL_000d: ldfld int32 StructUnion01/U::item1 + IL_0012: stloc.3 + IL_0013: ldloc.1 + IL_0014: ldfld int32 StructUnion01/U::item1 + IL_0019: stloc.s V_4 + IL_001b: ldloc.3 + IL_001c: ldloc.s V_4 + IL_001e: bge.s IL_0023 + + IL_0020: ldc.i4.m1 + IL_0021: br.s IL_0028 + + IL_0023: ldloc.3 + IL_0024: ldloc.s V_4 + IL_0026: cgt + IL_0028: stloc.2 + IL_0029: ldloc.2 + IL_002a: ldc.i4.0 + IL_002b: bge.s IL_002f + + IL_002d: ldloc.2 + IL_002e: ret + + IL_002f: ldloc.2 + IL_0030: ldc.i4.0 + IL_0031: ble.s IL_0035 + + IL_0033: ldloc.2 + IL_0034: ret + + IL_0035: ldarg.0 + IL_0036: ldfld int32 StructUnion01/U::item2 + IL_003b: stloc.3 + IL_003c: ldloc.1 + IL_003d: ldfld int32 StructUnion01/U::item2 + IL_0042: stloc.s V_4 + IL_0044: ldloc.3 + IL_0045: ldloc.s V_4 + IL_0047: bge.s IL_004b + + IL_0049: ldc.i4.m1 + IL_004a: ret + + IL_004b: ldloc.3 + IL_004c: ldloc.s V_4 + IL_004e: cgt + IL_0050: ret + } // end of method U::CompareTo + + .method public hidebysig virtual final + instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 50 (0x32) + .maxstack 7 + .locals init (int32 V_0) + IL_0000: ldc.i4.0 + IL_0001: stloc.0 + IL_0002: ldarg.0 + IL_0003: pop + IL_0004: ldc.i4.0 + IL_0005: stloc.0 + IL_0006: ldc.i4 0x9e3779b9 + IL_000b: ldarg.0 + IL_000c: ldfld int32 StructUnion01/U::item2 + IL_0011: ldloc.0 + IL_0012: ldc.i4.6 + IL_0013: shl + IL_0014: ldloc.0 + IL_0015: ldc.i4.2 + IL_0016: shr + IL_0017: add + IL_0018: add + IL_0019: add + IL_001a: stloc.0 + IL_001b: ldc.i4 0x9e3779b9 + IL_0020: ldarg.0 + IL_0021: ldfld int32 StructUnion01/U::item1 + IL_0026: ldloc.0 + IL_0027: ldc.i4.6 + IL_0028: shl + IL_0029: ldloc.0 + IL_002a: ldc.i4.2 + IL_002b: shr + IL_002c: add + IL_002d: add + IL_002e: add + IL_002f: stloc.0 + IL_0030: ldloc.0 + IL_0031: ret + } // end of method U::GetHashCode + + .method public hidebysig virtual final + instance int32 GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 12 (0xc) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0006: call instance int32 StructUnion01/U::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000b: ret + } // end of method U::GetHashCode + + .method public hidebysig virtual final + instance bool Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 53 (0x35) + .maxstack 4 + .locals init (valuetype StructUnion01/U V_0, + valuetype StructUnion01/U& V_1) + IL_0000: ldarg.1 + IL_0001: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_0006: brtrue.s IL_000a + + IL_0008: ldc.i4.0 + IL_0009: ret + + IL_000a: ldarg.1 + IL_000b: unbox.any StructUnion01/U + IL_0010: stloc.0 + IL_0011: ldloca.s V_0 + IL_0013: stloc.1 + IL_0014: ldarg.0 + IL_0015: pop + IL_0016: ldarg.0 + IL_0017: ldfld int32 StructUnion01/U::item1 + IL_001c: ldloc.1 + IL_001d: ldfld int32 StructUnion01/U::item1 + IL_0022: bne.un.s IL_0033 + + IL_0024: ldarg.0 + IL_0025: ldfld int32 StructUnion01/U::item2 + IL_002a: ldloc.1 + IL_002b: ldfld int32 StructUnion01/U::item2 + IL_0030: ceq + IL_0032: ret + + IL_0033: ldc.i4.0 + IL_0034: ret + } // end of method U::Equals + + .method public hidebysig virtual final + instance bool Equals(valuetype StructUnion01/U obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 36 (0x24) + .maxstack 4 + .locals init (valuetype StructUnion01/U& V_0) + IL_0000: ldarga.s obj + IL_0002: stloc.0 + IL_0003: ldarg.0 + IL_0004: pop + IL_0005: ldarg.0 + IL_0006: ldfld int32 StructUnion01/U::item1 + IL_000b: ldloc.0 + IL_000c: ldfld int32 StructUnion01/U::item1 + IL_0011: bne.un.s IL_0022 + + IL_0013: ldarg.0 + IL_0014: ldfld int32 StructUnion01/U::item2 + IL_0019: ldloc.0 + IL_001a: ldfld int32 StructUnion01/U::item2 + IL_001f: ceq + IL_0021: ret + + IL_0022: ldc.i4.0 + IL_0023: ret + } // end of method U::Equals + + .method public hidebysig virtual final + instance bool Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 23 (0x17) + .maxstack 8 + IL_0000: ldarg.1 + IL_0001: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_0006: brtrue.s IL_000a + + IL_0008: ldc.i4.0 + IL_0009: ret + + IL_000a: ldarg.0 + IL_000b: ldarg.1 + IL_000c: unbox.any StructUnion01/U + IL_0011: call instance bool StructUnion01/U::Equals(valuetype StructUnion01/U) + IL_0016: ret + } // end of method U::Equals + + .property instance int32 Tag() + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .get instance int32 StructUnion01/U::get_Tag() + } // end of property U::Tag + .property instance int32 Item1() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .get instance int32 StructUnion01/U::get_Item1() + } // end of property U::Item1 + .property instance int32 Item2() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32, + int32) = ( 01 00 04 00 00 00 00 00 00 00 01 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .get instance int32 StructUnion01/U::get_Item2() + } // end of property U::Item2 + } // end of class U + + .method public static int32 g1(valuetype StructUnion01/U _arg1) cil managed + { + // Code size 16 (0x10) + .maxstack 8 + IL_0000: ldarga.s _arg1 + IL_0002: ldfld int32 StructUnion01/U::item1 + IL_0007: ldarga.s _arg1 + IL_0009: ldfld int32 StructUnion01/U::item2 + IL_000e: add + IL_000f: ret + } // end of method StructUnion01::g1 + + .method public static int32 g2(valuetype StructUnion01/U u) cil managed + { + // Code size 16 (0x10) + .maxstack 8 + IL_0000: ldarga.s u + IL_0002: ldfld int32 StructUnion01/U::item1 + IL_0007: ldarga.s u + IL_0009: ldfld int32 StructUnion01/U::item2 + IL_000e: add + IL_000f: ret + } // end of method StructUnion01::g2 + + .method public static int32 g3(valuetype StructUnion01/U x) cil managed + { + // Code size 42 (0x2a) + .maxstack 8 + IL_0000: ldarga.s x + IL_0002: ldfld int32 StructUnion01/U::item1 + IL_0007: ldc.i4.3 + IL_0008: sub + IL_0009: switch ( + IL_0022) + IL_0012: ldarga.s x + IL_0014: ldfld int32 StructUnion01/U::item1 + IL_0019: ldarga.s x + IL_001b: ldfld int32 StructUnion01/U::item2 + IL_0020: add + IL_0021: ret + + IL_0022: ldarga.s x + IL_0024: ldfld int32 StructUnion01/U::item2 + IL_0029: ret + } // end of method StructUnion01::g3 + + .method public static int32 g4(valuetype StructUnion01/U x, + valuetype StructUnion01/U y) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationArgumentCountsAttribute::.ctor(int32[]) = ( 01 00 02 00 00 00 01 00 00 00 01 00 00 00 00 00 ) + // Code size 126 (0x7e) + .maxstack 6 + .locals init (int32 V_0, + int32 V_1, + int32 V_2, + int32 V_3) + IL_0000: ldarga.s x + IL_0002: ldfld int32 StructUnion01/U::item1 + IL_0007: ldc.i4.3 + IL_0008: sub + IL_0009: switch ( + IL_003a) + IL_0012: ldarga.s y + IL_0014: ldfld int32 StructUnion01/U::item2 + IL_0019: stloc.0 + IL_001a: ldarga.s y + IL_001c: ldfld int32 StructUnion01/U::item1 + IL_0021: stloc.1 + IL_0022: ldarga.s x + IL_0024: ldfld int32 StructUnion01/U::item2 + IL_0029: stloc.2 + IL_002a: ldarga.s x + IL_002c: ldfld int32 StructUnion01/U::item1 + IL_0031: stloc.3 + IL_0032: ldloc.3 + IL_0033: ldloc.2 + IL_0034: add + IL_0035: ldloc.1 + IL_0036: add + IL_0037: ldloc.0 + IL_0038: add + IL_0039: ret + + IL_003a: ldarga.s y + IL_003c: ldfld int32 StructUnion01/U::item1 + IL_0041: ldc.i4.5 + IL_0042: sub + IL_0043: switch ( + IL_006e) + IL_004c: ldarga.s y + IL_004e: ldfld int32 StructUnion01/U::item2 + IL_0053: ldarga.s y + IL_0055: ldfld int32 StructUnion01/U::item1 + IL_005a: ldarga.s x + IL_005c: ldfld int32 StructUnion01/U::item2 + IL_0061: ldarga.s x + IL_0063: ldfld int32 StructUnion01/U::item1 + IL_0068: stloc.3 + IL_0069: stloc.2 + IL_006a: stloc.1 + IL_006b: stloc.0 + IL_006c: br.s IL_0032 + + IL_006e: ldarga.s x + IL_0070: ldfld int32 StructUnion01/U::item2 + IL_0075: ldarga.s y + IL_0077: ldfld int32 StructUnion01/U::item2 + IL_007c: add + IL_007d: ret + } // end of method StructUnion01::g4 + + .method public static int32 f1(valuetype StructUnion01/U& x) cil managed + { + // Code size 23 (0x17) + .maxstack 4 + .locals init (valuetype StructUnion01/U V_0) + IL_0000: ldarg.0 + IL_0001: ldobj StructUnion01/U + IL_0006: stloc.0 + IL_0007: ldloca.s V_0 + IL_0009: ldfld int32 StructUnion01/U::item1 + IL_000e: ldloca.s V_0 + IL_0010: ldfld int32 StructUnion01/U::item2 + IL_0015: add + IL_0016: ret + } // end of method StructUnion01::f1 + + .method public static int32 f2(valuetype StructUnion01/U& x) cil managed + { + // Code size 23 (0x17) + .maxstack 4 + .locals init (valuetype StructUnion01/U V_0) + IL_0000: ldarg.0 + IL_0001: ldobj StructUnion01/U + IL_0006: stloc.0 + IL_0007: ldloca.s V_0 + IL_0009: ldfld int32 StructUnion01/U::item1 + IL_000e: ldloca.s V_0 + IL_0010: ldfld int32 StructUnion01/U::item2 + IL_0015: add + IL_0016: ret + } // end of method StructUnion01::f2 + + .method public static int32 f3(valuetype StructUnion01/U& x) cil managed + { + // Code size 49 (0x31) + .maxstack 4 + .locals init (valuetype StructUnion01/U V_0) + IL_0000: ldarg.0 + IL_0001: ldobj StructUnion01/U + IL_0006: stloc.0 + IL_0007: ldloca.s V_0 + IL_0009: ldfld int32 StructUnion01/U::item1 + IL_000e: ldc.i4.3 + IL_000f: sub + IL_0010: switch ( + IL_0029) + IL_0019: ldloca.s V_0 + IL_001b: ldfld int32 StructUnion01/U::item1 + IL_0020: ldloca.s V_0 + IL_0022: ldfld int32 StructUnion01/U::item2 + IL_0027: add + IL_0028: ret + + IL_0029: ldloca.s V_0 + IL_002b: ldfld int32 StructUnion01/U::item2 + IL_0030: ret + } // end of method StructUnion01::f3 + + .method public static int32 f4(valuetype StructUnion01/U& x, + valuetype StructUnion01/U& y) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationArgumentCountsAttribute::.ctor(int32[]) = ( 01 00 02 00 00 00 01 00 00 00 01 00 00 00 00 00 ) + // Code size 146 (0x92) + .maxstack 6 + .locals init (valuetype StructUnion01/U V_0, + valuetype StructUnion01/U V_1, + int32 V_2, + int32 V_3, + int32 V_4, + int32 V_5) + IL_0000: ldarg.0 + IL_0001: ldobj StructUnion01/U + IL_0006: stloc.0 + IL_0007: ldarg.1 + IL_0008: ldobj StructUnion01/U + IL_000d: stloc.1 + IL_000e: ldloca.s V_0 + IL_0010: ldfld int32 StructUnion01/U::item1 + IL_0015: ldc.i4.3 + IL_0016: sub + IL_0017: switch ( + IL_004c) + IL_0020: ldloca.s V_1 + IL_0022: ldfld int32 StructUnion01/U::item2 + IL_0027: stloc.2 + IL_0028: ldloca.s V_1 + IL_002a: ldfld int32 StructUnion01/U::item1 + IL_002f: stloc.3 + IL_0030: ldloca.s V_0 + IL_0032: ldfld int32 StructUnion01/U::item2 + IL_0037: stloc.s V_4 + IL_0039: ldloca.s V_0 + IL_003b: ldfld int32 StructUnion01/U::item1 + IL_0040: stloc.s V_5 + IL_0042: ldloc.s V_5 + IL_0044: ldloc.s V_4 + IL_0046: add + IL_0047: ldloc.3 + IL_0048: add + IL_0049: ldloc.2 + IL_004a: add + IL_004b: ret + + IL_004c: ldloca.s V_1 + IL_004e: ldfld int32 StructUnion01/U::item1 + IL_0053: ldc.i4.5 + IL_0054: sub + IL_0055: switch ( + IL_0082) + IL_005e: ldloca.s V_1 + IL_0060: ldfld int32 StructUnion01/U::item2 + IL_0065: ldloca.s V_1 + IL_0067: ldfld int32 StructUnion01/U::item1 + IL_006c: ldloca.s V_0 + IL_006e: ldfld int32 StructUnion01/U::item2 + IL_0073: ldloca.s V_0 + IL_0075: ldfld int32 StructUnion01/U::item1 + IL_007a: stloc.s V_5 + IL_007c: stloc.s V_4 + IL_007e: stloc.3 + IL_007f: stloc.2 + IL_0080: br.s IL_0042 + + IL_0082: ldloca.s V_0 + IL_0084: ldfld int32 StructUnion01/U::item2 + IL_0089: ldloca.s V_1 + IL_008b: ldfld int32 StructUnion01/U::item2 + IL_0090: add + IL_0091: ret + } // end of method StructUnion01::f4 + +} // end of class StructUnion01 + +.class private abstract auto ansi sealed ''.$StructUnion01 + extends [mscorlib]System.Object +{ +} // end of class ''.$StructUnion01 + + +// ============================================================= + +// *********** DISASSEMBLY COMPLETE *********************** diff --git a/tests/fsharpqa/Source/Optimizations/Inlining/env.lst b/tests/fsharpqa/Source/Optimizations/Inlining/env.lst index 36d62b41f3d..9c95c7c6545 100644 --- a/tests/fsharpqa/Source/Optimizations/Inlining/env.lst +++ b/tests/fsharpqa/Source/Optimizations/Inlining/env.lst @@ -1,2 +1,3 @@ NoMT SOURCE=Match01.fs SCFLAGS="-a --optimize+" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd Match01.dll" # Match01.fs NoMT SOURCE=Match02.fs SCFLAGS="-a --optimize+" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd Match02.dll" # Match02.fs +NoMT SOURCE=StructUnion01.fs SCFLAGS="-a --optimize+" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd StructUnion01.dll" # StructUnion01.fs diff --git a/tests/fsharpqa/Source/Warnings/RefCellInsteadOfNot.fs b/tests/fsharpqa/Source/Warnings/RefCellInsteadOfNot.fs new file mode 100644 index 00000000000..1c6987bfa63 --- /dev/null +++ b/tests/fsharpqa/Source/Warnings/RefCellInsteadOfNot.fs @@ -0,0 +1,9 @@ +// #Warnings +//This expression was expected to have type +//The '!' operator is used to dereference a ref cell. Consider using 'not expr' here. + +let x = true +if !x then + printfn "hello" + +exit 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Warnings/RefCellInsteadOfNot2.fs b/tests/fsharpqa/Source/Warnings/RefCellInsteadOfNot2.fs new file mode 100644 index 00000000000..090934d8f56 --- /dev/null +++ b/tests/fsharpqa/Source/Warnings/RefCellInsteadOfNot2.fs @@ -0,0 +1,8 @@ +// #Warnings +//This expression was expected to have type +//The '!' operator is used to dereference a ref cell. Consider using 'not expr' here. + +let x = true +let y = !x + +exit 0 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Warnings/WarnIfExpressionResultUnused.fs b/tests/fsharpqa/Source/Warnings/WarnIfExpressionResultUnused.fs new file mode 100644 index 00000000000..e43c60b38d9 --- /dev/null +++ b/tests/fsharpqa/Source/Warnings/WarnIfExpressionResultUnused.fs @@ -0,0 +1,5 @@ +// #Warnings +//The result of this expression is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ + +1 + 2 +printfn "%d" 3 diff --git a/tests/fsharpqa/Source/Warnings/env.lst b/tests/fsharpqa/Source/Warnings/env.lst index 89651c646aa..da119ba25d2 100644 --- a/tests/fsharpqa/Source/Warnings/env.lst +++ b/tests/fsharpqa/Source/Warnings/env.lst @@ -7,8 +7,11 @@ SOURCE=ElseBranchHasWrongType.fs # ElseBranchHasWrongType.fs SOURCE=MissingExpressionAfterLet.fs # MissingExpressionAfterLet.fs SOURCE=AssignmentOnImmutable.fs # AssignmentOnImmutable.fs + SOURCE=RefCellInsteadOfNot.fs # RefCellInsteadOfNot.fs + SOURCE=RefCellInsteadOfNot2.fs # RefCellInsteadOfNot2.fs SOURCE=UpcastInsteadOfDowncast.fs # UpcastInsteadOfDowncast.fs SOURCE=UpcastFunctionInsteadOfDowncast.fs # UpcastFunctionInsteadOfDowncast.fs SOURCE=DowncastInsteadOfUpcast.fs # DowncastInsteadOfUpcast.fs SOURCE=RuntimeTypeTestInPattern.fs # RuntimeTypeTestInPattern.fs SOURCE=RuntimeTypeTestInPattern2.fs # RuntimeTypeTestInPattern2.fs + SOURCE=WarnIfExpressionResultUnused.fs # WarnIfExpressionResultUnused.fs diff --git a/tests/fsharpqa/Source/test.lst b/tests/fsharpqa/Source/test.lst index b9391dc0801..8b87fc8a031 100644 --- a/tests/fsharpqa/Source/test.lst +++ b/tests/fsharpqa/Source/test.lst @@ -223,6 +223,7 @@ Conformance08 Conformance\PatternMatching\Wildcard Conformance08 Conformance\Signatures\SignatureConformance Conformance08 Conformance\Signatures\SignatureTypes Conformance08 Conformance\SpecialAttributesAndTypes\Imported\System.ThreadStatic +Conformance08 Conformance\SpecialAttributesAndTypes\Imported\CallerInfo Conformance08 Conformance\TypesAndTypeConstraints\CheckingSyntacticTypes Conformance08 Conformance\TypesAndTypeConstraints\LogicalPropertiesOfTypes Conformance08 Conformance\TypesAndTypeConstraints\TypeConstraints @@ -241,7 +242,7 @@ Misc01 ClrFx\PseudoCustomAttributes\AssemblyAlgorithmId Misc01 ClrFx\PseudoCustomAttributes\AssemblyConfiguration Misc01 ClrFx\PseudoCustomAttributes\AssemblyVersion Misc01 Diagnostics\async -Misc01 Diagnostics\General +Misc01,Diagnostics Diagnostics\General Misc01 Diagnostics\NONTERM Misc01 Diagnostics\ParsingAtEOF Misc01 EntryPoint @@ -276,4 +277,3 @@ Misc02 Stress Misc02 XmlDoc\Basic Misc02 XmlDoc\OCamlDoc Misc02 XmlDoc\UnitOfMeasure -Diagnostics Diagnostics\General diff --git a/tests/fsharpqa/testenv/bin/System.Reflection.Metadata.dll b/tests/fsharpqa/testenv/bin/System.Reflection.Metadata.dll index cb4cdd3431c..67c3785946d 100644 Binary files a/tests/fsharpqa/testenv/bin/System.Reflection.Metadata.dll and b/tests/fsharpqa/testenv/bin/System.Reflection.Metadata.dll differ diff --git a/tests/fsharpqa/testenv/bin/System.Reflection.Metadata.xml b/tests/fsharpqa/testenv/bin/System.Reflection.Metadata.xml index 771bf69d360..917c76095b2 100644 --- a/tests/fsharpqa/testenv/bin/System.Reflection.Metadata.xml +++ b/tests/fsharpqa/testenv/bin/System.Reflection.Metadata.xml @@ -4,426 +4,110 @@ System.Reflection.Metadata - - - Compares the current content of this writer with another one. - - - - Range specified by and falls outside of the bounds of the buffer content. - - - Range specified by and falls outside of the bounds of the buffer content. - - - is negative. - - - is null. - is negative. - - - is null. - - - is null. - is negative. - - - is null. - - - is null. - Range specified by and falls outside of the bounds of the . - - - is null. - - - is null. - Range specified by and falls outside of the bounds of the . - - - - Writes a reference to a heap (heap index) or a table (row id). - - - References may be small (2B) or large (4B). - - - - - Writes UTF16 (little-endian) encoded string at the current position. - - is null. - - + - Writes UTF16 (little-endian) encoded string at the current position. + Represents a disposable blob of memory accessed via unsafe pointer. - is null. - + - Writes string in SerString format (see ECMA-335-II 23.3 Custom attributes): - The string is UTF8 encoded and prefixed by the its size in bytes. - Null string is represented as a single byte 0xFF. + Pointer to the underlying data (not valid after disposal). - + - Writes UTF8 encoded string at the current position. + Size of the block. - is null. - + - Implements compressed signed integer encoding as defined by ECMA-335-II chapter 23.2: Blobs and signatures. + Returns the content of the entire memory block. - If the value lies between -64 (0xFFFFFFC0) and 63 (0x3F), inclusive, encode as a one-byte integer: - bit 7 clear, value bits 5 through 0 held in bits 6 through 1, sign bit (value bit 31) in bit 0. - - If the value lies between -8192 (0xFFFFE000) and 8191 (0x1FFF), inclusive, encode as a two-byte integer: - 15 set, bit 14 clear, value bits 12 through 0 held in bits 13 through 1, sign bit(value bit 31) in bit 0. + Does not check bounds. - If the value lies between -268435456 (0xF000000) and 268435455 (0x0FFFFFFF), inclusive, encode as a four-byte integer: - 31 set, 30 set, bit 29 clear, value bits 27 through 0 held in bits 28 through 1, sign bit(value bit 31) in bit 0. + Only creates a copy of the data if they are not represented by a managed byte array, + or if the specified range doens't span the entire block. - can't be represented as a compressed signed integer. - + - Implements compressed unsigned integer encoding as defined by ECMA-335-II chapter 23.2: Blobs and signatures. + Disposes the block. - If the value lies between 0 (0x00) and 127 (0x7F), inclusive, - encode as a one-byte integer (bit 7 is clear, value held in bits 6 through 0). - - If the value lies between 28 (0x80) and 214 – 1 (0x3FFF), inclusive, - encode as a 2-byte integer with bit 15 set, bit 14 clear(value held in bits 13 through 0). + The operation is idempotent, but must not be called concurrently with any other operations on the block + or with another call to Dispose. - Otherwise, encode as a 4-byte integer, with bit 31 set, bit 30 set, bit 29 clear (value held in bits 28 through 0). + Using the block after dispose is an error in our code and therefore no effort is made to throw a tidy + ObjectDisposedException and null ref or AV is possible. - can't be represented as a compressed signed integer. - - - - Writes a constant value (see ECMA-335 Partition II section 22.9) at the current position. - - is not of a constant type. - + - Returns a sequence of all blobs that represent the content of the builder. + Represents a memory block backed by an array of bytes. - Content is not available, the builder has been linked with another one. - + - Compares the current content of this writer with another one. + Class representing raw memory but not owning the memory. - Content is not available, the builder has been linked with another one. - - - Content is not available, the builder has been linked with another one. - - - Range specified by and falls outside of the bounds of the buffer content. - Content is not available, the builder has been linked with another one. - - - Content is not available, the builder has been linked with another one. - - - Range specified by and falls outside of the bounds of the buffer content. - Content is not available, the builder has been linked with another one. - - - is null. - Content is not available, the builder has been linked with another one. - - - is default(). - Content is not available, the builder has been linked with another one. - - - is null. - Content is not available, the builder has been linked with another one. - - - is null. - Builder is not writable, it has been linked with another one. - - - is null. - Builder is not writable, it has been linked with another one. - + - Reserves a contiguous block of bytes. + Represents raw memory owned by an external object. - is negative. - Builder is not writable, it has been linked with another one. - - - is negative. - Builder is not writable, it has been linked with another one. - - - is null. - is negative. - Builder is not writable, it has been linked with another one. - - - is null. - is negative. - Builder is not writable, it has been linked with another one. - Bytes successfully written from the . - - - is null. - Builder is not writable, it has been linked with another one. - - is null. - Range specified by and falls outside of the bounds of the . - Builder is not writable, it has been linked with another one. - - - is null. - Builder is not writable, it has been linked with another one. - - - is null. - Range specified by and falls outside of the bounds of the . - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - - Builder is not writable, it has been linked with another one. - - + - Writes a reference to a heap (heap index) or a table (row id). + Creates and hydrates a memory block representing all data. - - References may be small (2B) or large (4B). - - Builder is not writable, it has been linked with another one. + Error while reading from the memory source. - + - Writes UTF16 (little-endian) encoded string at the current position. + Creates and hydrates a memory block representing data in the specified range. - is null. - Builder is not writable, it has been linked with another one. + Starting offset relative to the beginning of the data represented by this provider. + Size of the resulting block. + Error while reading from the memory source. - - - Writes UTF16 (little-endian) encoded string at the current position. - - is null. - Builder is not writable, it has been linked with another one. + + IO error while reading from the underlying stream. - + - Writes string in SerString format (see ECMA-335-II 23.3 Custom attributes): - The string is UTF8 encoded and prefixed by the its size in bytes. - Null string is represented as a single byte 0xFF. + Gets a seekable and readable that can be used to read all data. + The operations on the stream has to be done under a lock of if non-null. + The image starts at and has size . + It is the caller's responsibility not to read outside those bounds. - Builder is not writable, it has been linked with another one. - + - Writes UTF8 encoded string at the current position. + The size of the data. - is null. - Builder is not writable, it has been linked with another one. - + - Implements compressed signed integer encoding as defined by ECMA-335-II chapter 23.2: Blobs and signatures. + Represents memory block allocated on native heap. - If the value lies between -64 (0xFFFFFFC0) and 63 (0x3F), inclusive, encode as a one-byte integer: - bit 7 clear, value bits 5 through 0 held in bits 6 through 1, sign bit (value bit 31) in bit 0. - - If the value lies between -8192 (0xFFFFE000) and 8191 (0x1FFF), inclusive, encode as a two-byte integer: - 15 set, bit 14 clear, value bits 12 through 0 held in bits 13 through 1, sign bit(value bit 31) in bit 0. - - If the value lies between -268435456 (0xF000000) and 268435455 (0x0FFFFFFF), inclusive, encode as a four-byte integer: - 31 set, 30 set, bit 29 clear, value bits 27 through 0 held in bits 28 through 1, sign bit(value bit 31) in bit 0. + Owns the native memory resource. - can't be represented as a compressed signed integer. - Builder is not writable, it has been linked with another one. - + - Implements compressed unsigned integer encoding as defined by ECMA-335-II chapter 23.2: Blobs and signatures. + Represents data read from a stream. - If the value lies between 0 (0x00) and 127 (0x7F), inclusive, - encode as a one-byte integer (bit 7 is clear, value held in bits 6 through 0). - - If the value lies between 28 (0x80) and 214 – 1 (0x3FFF), inclusive, - encode as a 2-byte integer with bit 15 set, bit 14 clear (value held in bits 13 through 0). - - Otherwise, encode as a 4-byte integer, with bit 31 set, bit 30 set, bit 29 clear (value held in bits 28 through 0). + Uses memory map to load data from streams backed by files that are bigger than . - can't be represented as a compressed integer. - Builder is not writable, it has been linked with another one. - - - - Writes a constant value (see ECMA-335 Partition II section 22.9) at the current position. - - is not of a constant type. - Builder is not writable, it has been linked with another one. - - - - Represents a disposable blob of memory accessed via unsafe pointer. - - - - Pointer to the underlying data (not valid after disposal). - + + Error while reading from the stream. - - - Returns the content of the memory block. - - - Only creates a copy of the data if they are not represented by a managed byte array, or the offset is non-zero. - - - - - Disposes the block. - - - The operation is idempotent, but must not be called concurrently with any other operations on the block - or with another call to Dispose. - - Using the block after dispose is an error in our code and therefore no effort is made to throw a tidy - ObjectDisposedException and null ref or AV is possible. - - - - - Represents a memory block backed by an array of bytes. - - - - - Class representing raw memory but not owning the memory. - - - - - Represents raw memory owned by an external object. - - - - - Creates and hydrates a memory block representing all data. - - Error while reading from the memory source. - - - - Creates and hydrates a memory block representing data in the specified range. - - Starting offset relative to the beginning of the data represented by this provider. - Size of the resulting block. - Error while reading from the memory source. - - - - Gets a seekable and readable that can be used to read all data. - The operations on the stream has to be done under a lock of if non-null. - The image starts at and has size . - It is the caller's responsibility not to read outside those bounds. - - - - - The size of the data. - - - - - Represents memory block allocated on native heap. - - - Owns the native memory resource. - - - - - Represents data read from a stream. - - - Uses memory map to load data from streams backed by files that are bigger than . - - - - Error while reading from the stream. + + IO error while mapping memory or not enough memory to create the mapping. @@ -510,7 +194,7 @@ Also, since we don't have access to immutable collection internals, we use a trick involving overlapping a with a refer. While - unverifiable, it is valid. See Ecma 335, section II.10.7 Controlling instance layout: + unverifiable, it is valid. See ECMA-335, section II.10.7 Controlling instance layout: "It is possible to overlap fields in this way, though offsets occupied by an object reference shall not overlap with offsets occupied by a built-in value type or a part of @@ -595,13 +279,13 @@ In a table that specifies children via a list field (e.g. TypeDef.FieldList, TypeDef.MethodList), - seaches for the parent given a reference to a child. + searches for the parent given a reference to a child. Returns row number [0..RowCount). - In a table ordered by a column containing entity references seaches for a row with the specified reference. + In a table ordered by a column containing entity references searches for a row with the specified reference. Returns row number [0..RowCount) or -1 if not found. @@ -684,493 +368,2160 @@ returned. - + - Serialized #Pdb stream. + Resolve image size as either the given user-specified size or distance from current position to end-of-stream. + Also performs the relevant argument validation and publicly visible caller has same argument names. + size is 0 and distance from current position to end-of-stream can't fit in Int32. + Size is negative or extends past the end-of-stream from current position. - + - Fills in stringIndexMap with data from stringIndex and write to stringWriter. - Releases stringIndex as the stringTable is sealed after this point. + Sets the capacity of the specified table. + is not a valid table index. + is negative. + + Use to reduce allocations if the approximate number of rows is known ahead of time. + - + - Sorts strings such that a string is followed immediately by all strings - that are a suffix of it. + Returns the current number of entires in the specified table. + Table index. + The number of entires in the table. + is not a valid table index. - + - Table row counts. + Returns the current number of entires in each table. + + An array of size with each item filled with the current row count of the corresponding table. + - + - External table row counts. + Adds a type definition. + Attributes + Namespace + Type name + , , or nil. + + If the type declares fields the handle of the first one, otherwise the handle of the first field declared by the next type definition. + If no type defines any fields in the module, (1). + + + If the type declares methods the handle of the first one, otherwise the handle of the first method declared by the next type definition. + If no type defines any methods in the module, (1). + + doesn't have the expected handle kind. - + - Non-empty tables that are emitted into the metadata table stream. + Adds an interface implementation to a type. + The type implementing the interface. + + The interface being implemented: + , or . + + doesn't have the expected handle kind. - + - Non-empty tables stored in an external metadata table stream that might be referenced from the metadata table stream being emitted. + Add a type reference. + + The entity declaring the target type: + , , , , or nil. + + Namespace. + Type name. + doesn't have the expected handle kind. + + + + Adds a property defintion. + + Attributes + Name + Signature of the property. + + + + Adds an event defintion. + + Attributes + Name + Type of the event: , , or + doesn't have the expected handle kind. + + + + Adds a default value for a parameter, field or property. + + , , or + The constant value. + doesn't have the expected handle kind. + + + + Associates a method (a getter, a setter, an adder, etc.) with a property or an event. + + or . + Semantics. + Method definition. + doesn't have the expected handle kind. + + + + Add a custom attribute. + + + An entity to attach the custom attribute to: + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + or + . + + + Custom attribute constructor: or + + + Custom attribute value blob. + + doesn't have the expected handle kind. - + - Exact (unaligned) heap sizes. + Adds a method specification (instantiation). + Generic method: or + Instantiation blob encoding the generic arguments of the method. + doesn't have the expected handle kind. - + - Overall size of metadata stream storage (stream headers, table stream, heaps, additional streams). - Aligned to . + Adds a parameter definition. + + Parameter name (optional). + Sequence number of the parameter. Value of 0 refers to the owner method's return type; its parameters are then numbered from 1 onwards. + is greater than . - + - The size of metadata stream (#- or #~). Aligned. - Aligned to . + Adds a generic parameter definition. + or + Attributes. + Parameter name. + Zero-based parameter index. + doesn't have the expected handle kind. + is greater than . - + - The size of #Pdb stream. Aligned. + Adds a type constraint to a generic parameter. + Generic parameter to constrain. + Type constraint: , or + doesn't have the expected handle kind. - + - Metadata header size. - Includes: - - metadata storage signature - - storage header - - stream headers + Add marshalling information to a field or a parameter. + or . + Descriptor. + doesn't have the expected handle kind. - + - Total size of metadata (header and all streams). + Adds a mapping from a field to its initial value stored in the PE image. + Field handle. + + Offset within the block in the PE image that stores initial values of mapped fields (usually in .text section). + The final relative virtual address stored in the metadata is calculated when the metadata is serialized + by adding the offset to the virtual address of the block start. + + is negative. - + - Provides an extension method to access the TypeDefinitionId column of the ExportedType table. + Adds a method definition. + + + Method name/ + Method signature. + + Offset within the block in the PE image that stores method bodies (IL stream), + or -1 if the method doesn't have a body. + + The final relative virtual address stored in the metadata is calculated when the metadata is serialized + by adding the offset to the virtual address of the beginning of the block. + + + If the method declares parameters in Params table the handle of the first one, otherwise the handle of the first parameter declared by the next method definition. + If no parameters are declared in the module, (1). + + is less than -1. - + - Gets a hint at the likely row number of the target type in the TypeDef table of its module. - If the namespaces and names do not match, resolution falls back to a full search of the - target TypeDef table. Ignored and should be zero if is - true. + Adds import information to a method definition (P/Invoke). + Method definition. + Attributes + Unmanaged method name. + Module containing the unmanaged method. - + - Provides extension methods for working with certain raw elements of the Ecma 335 metadata tables and heaps. + Defines an implementation for a method declaration within a type. + Type + or which provides the implementation. + or the method being implemented. + or doesn't have the expected handle kind. - + - Returns the number of rows in the specified table. + Adds a MemberRef table row. - is null. - is not a valid table index. + Containing entity: + , + , + , + , or + . + + Member name. + Member signature. + doesn't have the expected handle kind. - + - Returns the size of a row in the specified table. + Adds a manifest resource. - is null. - is not a valid table index. + Attributes + Resource name + , , or nil + Specifies the byte offset within the referenced file at which this resource record begins. + doesn't have the expected handle kind. - + - Returns the offset from the start of metadata to the specified table. + Adds an exported type. - is null. - is not a valid table index. + Attributes + Namespace + Type name + , or + Type definition id + doesn't have the expected handle kind. - + - Returns the size of the specified heap. + Adds declarative security attribute to a type, method or an assembly. - is null. - is not a valid heap index. + , , or + Security action + Permission set blob. + doesn't have the expected handle kind. - + - Returns the offset from the start of metadata to the specified heap. + Add document debug information. - is null. - is not a valid heap index. + + Document Name blob. + See https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#document-name-blob + + + GUID of the hash algorithm used to calculate the value of . + See https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#document-table-0x30 for common values. + + + The hash of the document content. + + + GUID of the language. + See https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#document-table-0x30 for common values. + - + - Returns the size of the specified heap. + Add method debug information. - is null. - is not a valid heap index. + + The handle of a single document containing all sequence points of the method, or nil if the method doesn't have sequence points or spans multiple documents. + + + Sequence Points blob, or nil if the method doesn't have sequence points. + See https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#sequence-points-blob. + - + - Returns the a handle to the UserString that follows the given one in the UserString heap or a nil handle if it is the last one. + Add local scope debug information. - is null. + The containing method. + Handle of the associated import scope. + + If the scope declares variables the handle of the first one, otherwise the handle of the first variable declared by the next scope definition. + If no scope defines any variables, (1). + + + If the scope declares constants the handle of the first one, otherwise the handle of the first constant declared by the next scope definition. + If no scope defines any constants, (1). + + Offset of the first instruction covered by the scope. + The length (in bytes) of the scope. - + - Returns the a handle to the Blob that follows the given one in the Blob heap or a nil handle if it is the last one. + Add local variable debug information. - is null. + + Local variable index in the local signature (zero-based). + Name of the variable. + is greater than . - + - Returns the a handle to the String that follows the given one in the String heap or a nil handle if it is the last one. + Add local constant debug information. - is null. + Name of the variable. + + LocalConstantSig blob, see https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#localconstantsig-blob. + - + - Enumerates entries of EnC log. + Add local scope debug information. - is null. + Parent scope handle. + + Imports blob, see https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#imports-blob. + - + + + Add state machine method debug information. + + Handle of the MoveNext method of the state machine (the compiler-generated method). + Handle of the kickoff method (the user defined iterator/async method) + + + + Add custom debug information. + + + An entity to attach the debug information to: + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + or + . + + Information kind. Determines the structure of the blob. + Custom debug information blob. + doesn't have the expected handle kind. + + - Enumerates entries of EnC map. + Creates a builder for metadata tables and heaps. - is null. + + Start offset of the User String heap. + The cumulative size of User String heaps of all previous EnC generations. Should be 0 unless the metadata is EnC delta metadata. + + + Start offset of the String heap. + The cumulative size of String heaps of all previous EnC generations. Should be 0 unless the metadata is EnC delta metadata. + + + Start offset of the Blob heap. + The cumulative size of Blob heaps of all previous EnC generations. Should be 0 unless the metadata is EnC delta metadata. + + + Start offset of the Guid heap. + The cumulative size of Guid heaps of all previous EnC generations. Should be 0 unless the metadata is EnC delta metadata. + + Offset is too big. + Offset is negative. + is not a multiple of size of GUID. - + - Enumerate types that define one or more properties. + Sets the capacity of the specified table. - - The resulting sequence corresponds exactly to entries in PropertyMap table, - i.e. n-th returned is stored in n-th row of PropertyMap. - + Heap index. + Number of bytes. + is not a valid heap index. + is negative. + + Use to reduce allocations if the approximate number of bytes is known ahead of time. + - + - Enumerate types that define one or more events. + Adds specified blob to Blob heap, if it's not there already. - - The resulting sequence corresponds exactly to entries in EventMap table, - i.e. n-th returned is stored in n-th row of EventMap. - + containing the blob. + Handle to the added or existing blob. + is null. - + - Maximum number of tables that can be present in Ecma335 metadata. + Adds specified blob to Blob heap, if it's not there already. + Array containing the blob. + Handle to the added or existing blob. + is null. - + - Maximum number of tables that can be present in Ecma335 metadata. + Adds specified blob to Blob heap, if it's not there already. + Array containing the blob. + Handle to the added or existing blob. + is null. - + - Returns the row number of a metadata table entry that corresponds - to the specified in the context of . + Encodes a constant value to a blob and adds it to the Blob heap, if it's not there already. + Uses UTF16 to encode string constants. - One based row number. - The is not a valid metadata table handle. + Constant value. + Handle to the added or existing blob. - + - Returns the offset of metadata heap data that corresponds - to the specified in the context of . + Encodes a string using UTF16 encoding to a blob and adds it to the Blob heap, if it's not there already. - Zero based offset, or -1 if isn't a metadata heap handle. - The operation is not supported for the specified . - The is invalid. + String. + Handle to the added or existing blob. + is null. - + - Returns the metadata token of the specified in the context of . + Encodes a string using UTF8 encoding to a blob and adds it to the Blob heap, if it's not there already. - Metadata token. - The operation is not supported for the specified . + Constant value. + + True to encode unpaired surrogates as specified, otherwise replace them with U+FFFD character. + + Handle to the added or existing blob. + is null. - + - Returns the metadata token of the specified in the context of . + Adds specified Guid to Guid heap, if it's not there already. - Metadata token. - - Handle represents a metadata entity that doesn't have a token. - A token can only be retrieved for a metadata table handle or a heap handle of type . - - The operation is not supported for the specified . + Guid to add. + Handle to the added or existing Guid. - + - Returns the row number of a metadata table entry that corresponds - to the specified . + Reserves space on the Guid heap for a GUID. - - One based row number, or -1 if can only be interpreted in a context of a specific . - See . - + + representing the GUID blob as stored on the heap. + + Handle to the reserved Guid. + The remaining space on the heap is too small to fit the string. - + - Returns the offset of metadata heap data that corresponds - to the specified . + Adds specified string to String heap, if it's not there already. + + Array containing the blob. + Handle to the added or existing blob. + is null. + + + + Reserves space on the User String heap for a string of specified length. + The number of characters to reserve. + + representing the entire User String blob (including its length and terminal character). + Use to fill in the content. + - Zero based offset, or -1 if can only be interpreted in a context of a specific . - See . + Handle to the reserved User String. + May be used in . + The remaining space on the heap is too small to fit the string. + is negative. - + - Returns the metadata token of the specified . + Adds specified string to User String heap, if it's not there already. + String to add. - Metadata token, or 0 if can only be interpreted in a context of a specific . - See . + Handle to the added or existing string. + May be used in . - - Handle represents a metadata entity that doesn't have a token. - A token can only be retrieved for a metadata table handle or a heap handle of type . - + The remaining space on the heap is too small to fit the string. + is null. - + - Returns the metadata token of the specified . + Fills in stringIndexMap with data from stringIndex and write to stringWriter. + Releases stringIndex as the stringTable is sealed after this point. - - Metadata token, or 0 if can only be interpreted in a context of a specific . - See . - - + - Gets the of the table corresponding to the specified . + Sorts strings such that a string is followed immediately by all strings + that are a suffix of it. - Handle type. - Table index. - True if the handle type corresponds to an Ecma335 table, false otherwise. - + - Gets the of the heap corresponding to the specified . + Builder of a Metadata Root to be embedded in a Portable Executable image. - Handle type. - Heap index. - True if the handle type corresponds to an Ecma335 heap, false otherwise. + + Metadata root constitutes of a metadata header followed by metadata streams (#~, #Strings, #US, #Guid and #Blob). + - + - Creates a handle from a token value. + Creates a builder of a metadata root. - - is not a valid metadata token. - It must encode a metadata table entity or an offset in heap. + + Builder populated with metadata entities stored in tables and values stored in heaps. + The entities and values will be enumerated when serializing the metadata root. + + + The version string written to the metadata header. The default value is "v4.0.30319". + + is null. + is too long (the number of bytes when UTF8-encoded must be less than 255). + + + + Metadata version string. + + + + + Returns sizes of various metadata structures. + + + + + Serialized the metadata root content into the given . + + Builder to write to. + + The relative virtual address of the start of the method body stream. + Used to calculate the final value of RVA fields of MethodDef table. + + + The relative virtual address of the start of the field init data stream. + Used to calculate the final value of RVA fields of FieldRVA table. + + is null. + or is negative. + + + + Decodes custom attribute blobs. + + + + + Calculates a HasCustomAttribute coded index for the specified handle. + + + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + or + . + + Unexpected handle kind. + + + + Calculates a HasConstant coded index for the specified handle. + + , , or + Unexpected handle kind. + + + + Calculates a CustomAttributeType coded index for the specified handle. + + or + Unexpected handle kind. + + + + Calculates a HasDeclSecurity coded index for the specified handle. + + , , or + Unexpected handle kind. + + + + Calculates a HasFieldMarshal coded index for the specified handle. + + or + Unexpected handle kind. + + + + Calculates a HasSemantics coded index for the specified handle. + + or + Unexpected handle kind. + + + + Calculates a Implementation coded index for the specified handle. + + , or + Unexpected handle kind. + + + + Calculates a MemberForwarded coded index for the specified handle. + + , + Unexpected handle kind. + + + + Calculates a MemberRefParent coded index for the specified handle. + + + , + , + , + , or + . + + Unexpected handle kind. + + + + Calculates a MethodDefOrRef coded index for the specified handle. + + or + Unexpected handle kind. + + + + Calculates a ResolutionScope coded index for the specified handle. + + , , or + Unexpected handle kind. + + + + Calculates a TypeDefOrRef coded index for the specified handle. + + or + Unexpected handle kind. + + + + Calculates a TypeDefOrRefOrSpec coded index for the specified handle. + + , or + Unexpected handle kind. + + + + Calculates a TypeOrMethodDef coded index for the specified handle. + + or + Unexpected handle kind. + + + + Calculates a HasCustomDebugInformation coded index for the specified handle. + + + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + or + . + + Unexpected handle kind. + + + + Builder of a Portable PDB image. + + + + + Creates a builder of a Portable PDB image. + + + Builder populated with debug metadata entities stored in tables and values stored in heaps. + The entities and values will be enumerated when serializing the Portable PDB image. + + + Row counts of all tables that the associated type-system metadata contain. + Each slot in the array corresponds to a table (). + The length of the array must be equal to . + + + Entry point method definition handle. + + + Function calculating id of content represented as a sequence of blobs. + If not specified a default function that ignores the content and returns current time-based content id is used + (). + You must specify a deterministic function to produce a deterministic Portable PDB image. + + or is null. + + + + Serialized #Pdb stream. + + + + + Serializes Portable PDB content into the given . + + Builder to write to. + The id of the serialized content. + is null. + + + is not in range [0, 0xffff]. + + + is not in range [0, 0xffff]. + + + is not in range [0, 0x1fffffff]. + + + is not in range [0, 0x1fffffff]. + + + + Encodes null literal of type . + + + + + Encodes constant literal. + + + Constant of type + , + , + , + , + , + , + , + , + , + , + , + (encoded as two-byte Unicode character), + (encoded as SerString), or + (encoded as the underlying integer value). + + Unexpected constant type. + + + + Encodes literal of type (possibly null). + + The name of the type, or null. + is empty. + + + + Writes primitive type code. + + Any primitive type code except for and . + is not valid in this context. + + + + Encodes a reference to a type. + + or . + True to mark the type as value type, false to mark it as a reference type in the signature. + doesn't have the expected handle kind. + + + + Starts a function pointer signature. + + Calling convention. + Function pointer attributes. + Generic parameter count. + is invalid. + is not in range [0, 0xffff]. + + + + Starts a generic instantiation signature. + + or . + Generic argument count. + True to mark the type as value type, false to mark it as a reference type in the signature. + doesn't have the expected handle kind. + is not in range [1, 0xffff]. + + + + Encodes a reference to type parameter of a containing generic method. + + Parameter index. + is not in range [0, 0xffff]. + + + + Encodes a reference to type parameter of a containing generic type. + + Parameter index. + is not in range [0, 0xffff]. + + + + Starts pointer signature. + + + + + Encodes void*. + + + + + Starts SZ array (vector) signature. + + + + + Starts a signature of a type with custom modifiers. + + + + + Encodes a custom modifier. + + , or . + Is optional modifier. + Encoder of subsequent modifiers. + is nil or of an unexpected kind. + + + + Encodes array shape. + + The number of dimensions in the array (shall be 1 or more). + + Dimension sizes. The array may be shorter than but not longer. + + + Dimension lower bounds, or default() to set all lower bounds to 0. + The array may be shorter than but not longer. + + + is outside of range [1, 0xffff], + smaller than .Length, or + smaller than .Length. + is null. + + + + Provides information on sizes of various metadata structures. + + + + + Exact (unaligned) heap sizes. + + Use to get an aligned heap size. + + + + Table row counts. + + + + + External table row counts. + + + + + Non-empty tables that are emitted into the metadata table stream. + + + + + Non-empty tables stored in an external metadata table stream that might be referenced from the metadata table stream being emitted. + + + + + Overall size of metadata stream storage (stream headers, table stream, heaps, additional streams). + Aligned to . + + + + + The size of metadata stream (#- or #~). Aligned. + Aligned to . + + + + + The size of #Pdb stream. Aligned. + + + + + Metadata header size. + Includes: + - metadata storage signature + - storage header + - stream headers + + + + + Total size of metadata (header and all streams). + + + + + Returns aligned size of the specified heap. + + + + + Decodes signature blobs. + See Metadata Specification section II.23.2: Blobs and signatures. + + + + + Creates a new SignatureDecoder. + + The provider used to obtain type symbols as the signature is decoded. + + The metadata reader from which the signature was obtained. It may be null if the given provider allows it. + + + + + Decodes a type embedded in a signature and advances the reader past the type. + + The blob reader positioned at the leading SignatureTypeCode + Allow a to follow a (CLASS | VALUETYPE) in the signature. + At present, the only context where that would be valid is in a LocalConstantSig as defined by the Portable PDB specification. + + The decoded type. + The reader was not positioned at a valid signature type. + + + + Decodes a list of types, with at least one instance that is preceded by its count as a compressed integer. + + + + + Decodes a method (definition, reference, or standalone) or property signature blob. + + BlobReader positioned at a method signature. + The decoded method signature. + The method signature is invalid. + + + + Decodes a method specification signature blob and advances the reader past the signature. + + A BlobReader positioned at a valid method specification signature. + The types used to instantiate a generic method via the method specification. + + + + Decodes a local variable signature blob and advances the reader past the signature. + + The blob reader positioned at a local variable signature. + The local variable types. + The local variable signature is invalid. + + + + Decodes a field signature blob and advances the reader past the signature. + + The blob reader positioned at a field signature. + The decoded field type. + + + + Provides an extension method to access the TypeDefinitionId column of the ExportedType table. + + + + + Gets a hint at the likely row number of the target type in the TypeDef table of its module. + If the namespaces and names do not match, resolution falls back to a full search of the + target TypeDef table. Ignored and should be zero if is + true. + + + + + Provides extension methods for working with certain raw elements of the ECMA-335 metadata tables and heaps. + + + + + Returns the number of rows in the specified table. + + is null. + is not a valid table index. + + + + Returns the size of a row in the specified table. + + is null. + is not a valid table index. + + + + Returns the offset from the start of metadata to the specified table. + + is null. + is not a valid table index. + + + + Returns the size of the specified heap. + + is null. + is not a valid heap index. + + + + Returns the offset from the start of metadata to the specified heap. + + is null. + is not a valid heap index. + + + + Returns the size of the specified heap. + + is null. + is not a valid heap index. + + + + Returns the a handle to the UserString that follows the given one in the UserString heap or a nil handle if it is the last one. + + is null. + + + + Returns the a handle to the Blob that follows the given one in the Blob heap or a nil handle if it is the last one. + + is null. + + + + Returns the a handle to the String that follows the given one in the String heap or a nil handle if it is the last one. + + is null. + + + + Enumerates entries of EnC log. + + is null. + + + + Enumerates entries of EnC map. + + is null. + + + + Enumerate types that define one or more properties. + + + The resulting sequence corresponds exactly to entries in PropertyMap table, + i.e. n-th returned is stored in n-th row of PropertyMap. + + + + + Enumerate types that define one or more events. + + + The resulting sequence corresponds exactly to entries in EventMap table, + i.e. n-th returned is stored in n-th row of EventMap. + + + + + Given a type handle and a raw type kind found in a signature blob determines whether the target type is a value type or a reference type. + + + + + Maximum number of tables that can be present in Ecma335 metadata. + + + + + Maximum number of tables that can be present in Ecma335 metadata. + + + + + Returns the row number of a metadata table entry that corresponds + to the specified in the context of . + + One based row number. + The is not a valid metadata table handle. + + + + Returns the offset of metadata heap data that corresponds + to the specified in the context of . + + Zero based offset, or -1 if isn't a metadata heap handle. + The operation is not supported for the specified . + The is invalid. + + + + Returns the metadata token of the specified in the context of . + + Metadata token. + The operation is not supported for the specified . + + + + Returns the metadata token of the specified in the context of . + + Metadata token. + + Handle represents a metadata entity that doesn't have a token. + A token can only be retrieved for a metadata table handle or a heap handle of type . + + The operation is not supported for the specified . + + + + Returns the row number of a metadata table entry that corresponds + to the specified . + + + One based row number, or -1 if can only be interpreted in a context of a specific . + See . + + + + + Returns the offset of metadata heap data that corresponds + to the specified . + + + An offset in the corresponding heap, or -1 if can only be interpreted in a context of a specific or . + See . + + + + + Returns the offset of metadata heap data that corresponds + to the specified . + + + Zero based offset, or -1 if can only be interpreted in a context of a specific or . + See . + + + + + Returns the offset of metadata heap data that corresponds + to the specified . + + + Zero based offset, or -1 if can only be interpreted in a context of a specific or . + See . + + + + + Returns the offset of metadata heap data that corresponds + to the specified . + + + Zero based offset, or -1 if can only be interpreted in a context of a specific or . + See . + + + + + Returns the offset of metadata heap data that corresponds + to the specified . + + + Zero based offset, or -1 if can only be interpreted in a context of a specific or . + See . + + + + + Returns the metadata token of the specified . + + + Metadata token, or 0 if can only be interpreted in a context of a specific . + See . + + + Handle represents a metadata entity that doesn't have a token. + A token can only be retrieved for a metadata table handle or a heap handle of type . + + + + + Returns the metadata token of the specified . + + + Metadata token, or 0 if can only be interpreted in a context of a specific . + See . + + + + + Gets the of the table corresponding to the specified . + + Handle type. + Table index. + True if the handle type corresponds to an Ecma335 or Portable PDB table, false otherwise. + + + + Gets the of the heap corresponding to the specified . + + Handle type. + Heap index. + True if the handle type corresponds to an Ecma335 heap, false otherwise. + + + + Creates a handle from a token value. + + + is not a valid metadata token. + It must encode a metadata table entity or an offset in heap. + + + + + Creates an entity handle from a token value. + + is not a valid metadata entity token. + + + + Creates an from a token value. + + + is not a valid table index. + + + + Creates an from a token value. + + + is not a valid table index. + + + + Returns true if the given raw (non-virtual) handle represents the same string as given ASCII string. + + + + + Returns the heap index of the given ASCII character or -1 if not found prior null terminator or end of heap. + + + + + Returns true if the given raw (non-virtual) handle represents a string that starts with given ASCII prefix. + + + + + Equivalent to Array.BinarySearch, searches for given raw (non-virtual) handle in given array of ASCII strings. + + + + + These constants are all in the byte range and apply to the interpretation of , + + + + + Use the highest bit to mark tokens that are virtual (synthesized). + We create virtual tokens to represent projected WinMD entities. + + + + + In the case of string handles, the two lower bits that (in addition to the + virtual bit not included in this mask) encode how to obtain the string value. + + + + + Use the highest bit to mark tokens that are virtual (synthesized). + We create virtual tokens to represent projected WinMD entities. + + + + + Returns true if the token value can escape the metadata reader. + We don't allow virtual tokens and heap tokens other than UserString to escape + since the token type ids are internal to the reader and not specified by ECMA spec. + + Spec (Partition III, 1.9 Metadata tokens): + Many CIL instructions are followed by a "metadata token". This is a 4-byte value, that specifies a row in a + metadata table, or a starting byte offset in the User String heap. + + For example, a value of 0x02 specifies the TypeDef table; a value of 0x70 specifies the User + String heap.The value corresponds to the number assigned to that metadata table (see Partition II for the full + list of tables) or to 0x70 for the User String heap.The least-significant 3 bytes specify the target row within that + metadata table, or starting byte offset within the User String heap. + + + + + Returns whether the namespaceTable has been created. If it hasn't, calling a GetXXX method + on this will probably have a very high amount of overhead. + + + + + This will return a StringHandle for the simple name of a namespace name at the given segment index. + If no segment index is passed explicitly or the "segment" index is greater than or equal to the number + of segments, then the last segment is used. "Segment" in this context refers to part of a namespace + name between dots. + + Example: Given a NamespaceDefinitionHandle to "System.Collections.Generic.Test" called 'handle': + + reader.GetString(GetSimpleName(handle)) == "Test" + reader.GetString(GetSimpleName(handle, 0)) == "System" + reader.GetString(GetSimpleName(handle, 1)) == "Collections" + reader.GetString(GetSimpleName(handle, 2)) == "Generic" + reader.GetString(GetSimpleName(handle, 3)) == "Test" + reader.GetString(GetSimpleName(handle, 1000)) == "Test" + + + + + Two distinct namespace handles represent the same namespace if their full names are the same. This + method merges builders corresponding to such namespace handles. + + + + + This will take 'table' and merge all of the NamespaceData instances that point to the same + namespace. It has to create 'stringTable' as an intermediate dictionary, so it will hand it + back to the caller should the caller want to use it. + + + + + Creates a NamespaceDataBuilder instance that contains a synthesized NamespaceDefinitionHandle, + as well as the name provided. + + + + + Quick convenience method that handles linking together child + parent + + + + + Links a child to its parent namespace. If the parent namespace doesn't exist, this will create a + virtual one. This will automatically link any virtual namespaces it creates up to its parents. + + + + + This will link all parents/children in the given namespaces dictionary up to each other. + + In some cases, we need to synthesize namespaces that do not have any type definitions or forwarders + of their own, but do have child namespaces. These are returned via the virtualNamespaces out + parameter. + + + + + Loops through all type definitions in metadata, adding them to the given table + + + + + Loops through all type forwarders in metadata, adding them to the given table + + + + + Populates namespaceList with distinct namespaces. No ordering is guaranteed. + + + + + If the namespace table doesn't exist, populates it! + + + + + If the namespace list doesn't exist, populates it! + + + + + An intermediate class used to build NamespaceData instances. This was created because we wanted to + use ImmutableArrays in NamespaceData, but having ArrayBuilders and ImmutableArrays that served the + same purpose in NamespaceData got ugly. With the current design of how we create our Namespace + dictionary, this needs to be a class because we have a many-to-one mapping between NamespaceHandles + and NamespaceData. So, the pointer semantics must be preserved. + + This class assumes that the builders will not be modified in any way after the first call to + Freeze(). + + + + + Returns a NamespaceData that represents this NamespaceDataBuilder instance. After calling + this method, it is an error to use any methods or fields except Freeze() on the target + NamespaceDataBuilder. + + + + + Returns field offset for given field RowId, or -1 if not available. + + + + + In CLI metadata equal to the actual number of entries in AssemblyRef table. + In WinMD metadata it includes synthesized AssemblyRefs in addition. + + + + + Represents a metadata entity (type reference/definition/specification, method definition, custom attribute, etc.). + + + Use to store multiple kinds of entity handles. + It has smaller memory footprint than . + + + + + Value stored in a specific entity handle (see , , etc.). + + + + + Compares the current content of this writer with another one. + + + + Range specified by and falls outside of the bounds of the buffer content. + + + Range specified by and falls outside of the bounds of the buffer content. + + + is negative. + + + is null. + is negative. + + + is null. + + + is null. + is negative. + + + is null. + + + is null. + Range specified by and falls outside of the bounds of the . + + + is null. + + + is null. + Range specified by and falls outside of the bounds of the . + + + + Writes a reference to a heap (heap offset) or a table (row number). + + Heap offset or table row number. + True to encode the reference as 16-bit integer, false to encode as 32-bit integer. + + + + Writes UTF16 (little-endian) encoded string at the current position. + + is null. + + + + Writes UTF16 (little-endian) encoded string at the current position. + + is null. + + + + Writes string in SerString format (see ECMA-335-II 23.3 Custom attributes). + + + The string is UTF8 encoded and prefixed by the its size in bytes. + Null string is represented as a single byte 0xFF. + + Builder is not writable, it has been linked with another one. + + + + Writes string in User String (#US) heap format (see ECMA-335-II 24.2.4 #US and #Blob heaps): + + + The string is UTF16 encoded and prefixed by the its size in bytes. + + This final byte holds the value 1 if and only if any UTF16 character within the string has any bit set in its top byte, + or its low byte is any of the following: 0x01–0x08, 0x0E–0x1F, 0x27, 0x2D, 0x7F. Otherwise, it holds 0. + The 1 signifies Unicode characters that require handling beyond that normally provided for 8-bit encoding sets. + + Builder is not writable, it has been linked with another one. + + + + Writes UTF8 encoded string at the current position. + + is null. + + + + Implements compressed signed integer encoding as defined by ECMA-335-II chapter 23.2: Blobs and signatures. + + + If the value lies between -64 (0xFFFFFFC0) and 63 (0x3F), inclusive, encode as a one-byte integer: + bit 7 clear, value bits 5 through 0 held in bits 6 through 1, sign bit (value bit 31) in bit 0. + + If the value lies between -8192 (0xFFFFE000) and 8191 (0x1FFF), inclusive, encode as a two-byte integer: + 15 set, bit 14 clear, value bits 12 through 0 held in bits 13 through 1, sign bit(value bit 31) in bit 0. + + If the value lies between -268435456 (0xF000000) and 268435455 (0x0FFFFFFF), inclusive, encode as a four-byte integer: + 31 set, 30 set, bit 29 clear, value bits 27 through 0 held in bits 28 through 1, sign bit(value bit 31) in bit 0. + + can't be represented as a compressed signed integer. + + + + Implements compressed unsigned integer encoding as defined by ECMA-335-II chapter 23.2: Blobs and signatures. + + + If the value lies between 0 (0x00) and 127 (0x7F), inclusive, + encode as a one-byte integer (bit 7 is clear, value held in bits 6 through 0). + + If the value lies between 28 (0x80) and 214 – 1 (0x3FFF), inclusive, + encode as a 2-byte integer with bit 15 set, bit 14 clear(value held in bits 13 through 0). + + Otherwise, encode as a 4-byte integer, with bit 31 set, bit 30 set, bit 29 clear (value held in bits 28 through 0). + + can't be represented as a compressed unsigned integer. + + + + Writes a constant value (see ECMA-335 Partition II section 22.9) at the current position. + + is not of a constant type. + + + + Returns a sequence of all blobs that represent the content of the builder. + + Content is not available, the builder has been linked with another one. + + + + Compares the current content of this writer with another one. + + Content is not available, the builder has been linked with another one. + + + Content is not available, the builder has been linked with another one. + + + Range specified by and falls outside of the bounds of the buffer content. + Content is not available, the builder has been linked with another one. + + + Content is not available, the builder has been linked with another one. + + + Range specified by and falls outside of the bounds of the buffer content. + Content is not available, the builder has been linked with another one. + + + is null. + Content is not available, the builder has been linked with another one. + + + is default(). + Content is not available, the builder has been linked with another one. + + + is null. + Content is not available, the builder has been linked with another one. + + + is null. + Builder is not writable, it has been linked with another one. + + + is null. + Builder is not writable, it has been linked with another one. + + + + Reserves a contiguous block of bytes. + + is negative. + Builder is not writable, it has been linked with another one. + + + is negative. + Builder is not writable, it has been linked with another one. + + + is null. + is negative. + Builder is not writable, it has been linked with another one. + + + is null. + is negative. + Builder is not writable, it has been linked with another one. + Bytes successfully written from the . + + + is null. + Builder is not writable, it has been linked with another one. + + + is null. + Range specified by and falls outside of the bounds of the . + Builder is not writable, it has been linked with another one. + + + is null. + Builder is not writable, it has been linked with another one. + + + is null. + Range specified by and falls outside of the bounds of the . + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + Builder is not writable, it has been linked with another one. + + + + Writes a reference to a heap (heap offset) or a table (row number). + + Heap offset or table row number. + True to encode the reference as 16-bit integer, false to encode as 32-bit integer. + Builder is not writable, it has been linked with another one. + + + + Writes UTF16 (little-endian) encoded string at the current position. + + is null. + Builder is not writable, it has been linked with another one. + + + + Writes UTF16 (little-endian) encoded string at the current position. + + is null. + Builder is not writable, it has been linked with another one. + + + + Writes string in SerString format (see ECMA-335-II 23.3 Custom attributes). + + + The string is UTF8 encoded and prefixed by the its size in bytes. + Null string is represented as a single byte 0xFF. + + Builder is not writable, it has been linked with another one. - + - Creates an entity handle from a token value. + Writes string in User String (#US) heap format (see ECMA-335-II 24.2.4 #US and #Blob heaps): - is not a valid metadata entity token. + + The string is UTF16 encoded and prefixed by the its size in bytes. + + This final byte holds the value 1 if and only if any UTF16 character within the string has any bit set in its top byte, + or its low byte is any of the following: 0x01–0x08, 0x0E–0x1F, 0x27, 0x2D, 0x7F. Otherwise, it holds 0. + The 1 signifies Unicode characters that require handling beyond that normally provided for 8-bit encoding sets. + + Builder is not writable, it has been linked with another one. - + - Creates an from a token value. + Writes UTF8 encoded string at the current position. - - is not a valid table index. + Constant value. + + True to encode unpaired surrogates as specified, otherwise replace them with U+FFFD character. + + is null. + Builder is not writable, it has been linked with another one. - + - Creates an from a token value. + Implements compressed signed integer encoding as defined by ECMA-335-II chapter 23.2: Blobs and signatures. - - is not a valid table index. + + If the value lies between -64 (0xFFFFFFC0) and 63 (0x3F), inclusive, encode as a one-byte integer: + bit 7 clear, value bits 5 through 0 held in bits 6 through 1, sign bit (value bit 31) in bit 0. + + If the value lies between -8192 (0xFFFFE000) and 8191 (0x1FFF), inclusive, encode as a two-byte integer: + 15 set, bit 14 clear, value bits 12 through 0 held in bits 13 through 1, sign bit(value bit 31) in bit 0. + + If the value lies between -268435456 (0xF000000) and 268435455 (0x0FFFFFFF), inclusive, encode as a four-byte integer: + 31 set, 30 set, bit 29 clear, value bits 27 through 0 held in bits 28 through 1, sign bit(value bit 31) in bit 0. + + can't be represented as a compressed signed integer. + Builder is not writable, it has been linked with another one. - + - Returns true if the given raw (non-virtual) handle represents the same string as given ASCII string. + Implements compressed unsigned integer encoding as defined by ECMA-335-II chapter 23.2: Blobs and signatures. + + If the value lies between 0 (0x00) and 127 (0x7F), inclusive, + encode as a one-byte integer (bit 7 is clear, value held in bits 6 through 0). + + If the value lies between 28 (0x80) and 214 – 1 (0x3FFF), inclusive, + encode as a 2-byte integer with bit 15 set, bit 14 clear (value held in bits 13 through 0). + + Otherwise, encode as a 4-byte integer, with bit 31 set, bit 30 set, bit 29 clear (value held in bits 28 through 0). + + can't be represented as a compressed unsigned integer. + Builder is not writable, it has been linked with another one. - + - Returns the heap index of the given ASCII character or -1 if not found prior null terminator or end of heap. + Writes a constant value (see ECMA-335 Partition II section 22.9) at the current position. + is not of a constant type. + Builder is not writable, it has been linked with another one. - + - Returns true if the given raw (non-virtual) handle represents a string that starts with given ASCII prefix. + Gets the TType representation for . - + - Equivalent to Array.BinarySearch, searches for given raw (non-virtual) handle in given array of ASCII strings. + Returns true if the given type represents . - + - These contants are all in the byte range and apply to the interpretation of , + Get the type symbol for the given serialized type name. + The serialized type name is in so-called "reflection notation" (i.e. as understood by .) + The name is malformed. - + - Use the highest bit to mark tokens that are virtual (synthesized). - We create virtual tokens to represent projected WinMD entities. + Gets the underlying type of the given enum type symbol. + The given type symbol does not represent an enum. - + - In the case of string handles, the two lower bits that (in addition to the - virtual bit not included in this mask) encode how to obtain the string value. + Returns true of the specified op-code is a branch to a label. - + - Use the highest bit to mark tokens that are virtual (synthesized). - We create virtual tokens to represent projected WinMD entities. + Calculate the size of the specified branch instruction operand. + Branch op-code. + 1 if is a short branch or 4 if it is a long branch. + Specified is not a branch op-code. - + - Returns true if the token value can escape the metadata reader. - We don't allow virtual tokens and heap tokens other than UserString to escape - since the token type ids are internal to the reader and not specified by ECMA spec. - - Spec (Partition III, 1.9 Metadata tokens): - Many CIL instructions are followed by a "metadata token". This is a 4-byte value, that specifies a row in a - metadata table, or a starting byte offset in the User String heap. - - For example, a value of 0x02 specifies the TypeDef table; a value of 0x70 specifies the User - String heap.The value corresponds to the number assigned to that metadata table (see Partition II for the full - list of tables) or to 0x70 for the User String heap.The least-significant 3 bytes specify the target row within that - metadata table, or starting byte offset within the User String heap. + Get a short form of the specified branch op-code. + Branch op-code. + Short form of the branch op-code. + Specified is not a branch op-code. - + - Returns whether the namespaceTable has been created. If it hasn't, calling a GetXXX method - on this will probably have a very high amount of overhead. + Get a long form of the specified branch op-code. + Branch op-code. + Long form of the branch op-code. + Specified is not a branch op-code. - - - This will return a StringHandle for the simple name of a namespace name at the given segment index. - If no segment index is passed explicitly or the "segment" index is greater than or equal to the number - of segments, then the last segment is used. "Segment" in this context refers to part of a namespace - name between dots. - - Example: Given a NamespaceDefinitionHandle to "System.Collections.Generic.Test" called 'handle': - - reader.GetString(GetSimpleName(handle)) == "Test" - reader.GetString(GetSimpleName(handle, 0)) == "System" - reader.GetString(GetSimpleName(handle, 1)) == "Collections" - reader.GetString(GetSimpleName(handle, 2)) == "Generic" - reader.GetString(GetSimpleName(handle, 3)) == "Test" - reader.GetString(GetSimpleName(handle, 1000)) == "Test" - + + + By default the stream is disposed when is disposed and sections of the PE image are read lazily. + - + - Two distinct namespace handles represent the same namespace if their full names are the same. This - method merges builders corresponding to such namespace handles. + Keep the stream open when the is disposed. - + - This will take 'table' and merge all of the NamespaceData instances that point to the same - namespace. It has to create 'stringTable' as an intermediate dictionary, so it will hand it - back to the caller should the caller want to use it. + Reads PDB metadata into memory right away. + + The underlying file may be closed and even deleted after is constructed. + closes the stream automatically by the time the constructor returns unless is specified. + - + - Creates a NamespaceDataBuilder instance that contains a synthesized NamespaceDefinitionHandle, - as well as the name provided. + Provides a metadata stored in an array of bytes, a memory block, or a stream. + + Supported formats: + - ECMA-335 CLI (Common Language Infrastructure) metadata () + - Edit and Continue metadata delta () + - Portable PDB metadata () + - + - Quick convenience method that handles linking together child + parent + Creates a Portable PDB metadata provider over a blob stored in memory. + Pointer to the start of the Portable PDB blob. + The size of the Portable PDB blob. + is . + is negative. + + The memory is owned by the caller and not released on disposal of the . + The caller is responsible for keeping the memory alive and unmodified throughout the lifetime of the . + The content of the blob is not read during the construction of the + - + - Links a child to its parent namespace. If the parent namespace doesn't exist, this will create a - virtual one. This will automatically link any virtual namespaces it creates up to its parents. + Creates a metadata provider over an image stored in memory. + Pointer to the start of the metadata blob. + The size of the metadata blob. + is . + is negative. + + The memory is owned by the caller and not released on disposal of the . + The caller is responsible for keeping the memory alive and unmodified throughout the lifetime of the . + The content of the blob is not read during the construction of the + - + - This will link all parents/children in the given namespaces dictionary up to each other. - - In some cases, we need to synthesize namespaces that do not have any type definitions or forwarders - of their own, but do have child namespaces. These are returned via the virtualNamespaces out - parameter. + Creates a Portable PDB metadata provider over a byte array. + Portable PDB image. + + The content of the image is not read during the construction of the + + is null. - + - Loops through all type definitions in metadata, adding them to the given table + Creates a provider over a byte array. + Metadata image. + + The content of the image is not read during the construction of the + + is null. - + - Loops through all type forwarders in metadata, adding them to the given table + Creates a provider for a stream of the specified size beginning at its current position. + Stream. + Size of the metadata blob in the stream. If not specified the metadata blob is assumed to span to the end of the stream. + + Options specifying how sections of the image are read from the stream. + + Unless is specified, ownership of the stream is transferred to the + upon successful argument validation. It will be disposed by the and the caller must not manipulate it. + + Unless is specified no data + is read from the stream during the construction of the . Furthermore, the stream must not be manipulated + by caller while the is alive and undisposed. + + If , the + will have read all of the data requested during construction. As such, if is also + specified, the caller retains full ownership of the stream and is assured that it will not be manipulated by the + after construction. + + Size is negative or extends past the end of the stream. - + - Populates namespaceList with distinct namespaces. No ordering is guaranteed. + Creates a provider for a stream of the specified size beginning at its current position. + Stream. + Size of the metadata blob in the stream. If not specified the metadata blob is assumed to span to the end of the stream. + + Options specifying how sections of the image are read from the stream. + + Unless is specified, ownership of the stream is transferred to the + upon successful argument validation. It will be disposed by the and the caller must not manipulate it. + + Unless is specified no data + is read from the stream during the construction of the . Furthermore, the stream must not be manipulated + by caller while the is alive and undisposed. + + If , the + will have read all of the data requested during construction. As such, if is also + specified, the caller retains full ownership of the stream and is assured that it will not be manipulated by the + after construction. + + Size is negative or extends past the end of the stream. - + - If the namespace table doesn't exist, populates it! + Disposes all memory allocated by the reader. + + can be called multiple times (but not in parallel). + It is not safe to call in parallel with any other operation on the + or reading from the underlying memory. + - + - If the namespace list doesn't exist, populates it! + Gets a from a . + + The caller must keep the alive and undisposed throughout the lifetime of the metadata reader. + + The encoding of is not . + The current platform is big-endian. + IO error while reading from the underlying stream. - + + IO error while reading from the underlying stream. + + - An intermediate class used to build NamespaceData instances. This was created because we wanted to - use ImmutableArrays in NamespaceData, but having ArrayBuilders and ImmutableArrays that served the - same purpose in NamespaceData got ugly. With the current design of how we create our Namespace - dictionary, this needs to be a class because we have a many-to-one mapping between NamespaceHandles - and NamespaceData. So, the pointer semantics must be preserved. - - This class assumes that the builders will not be modified in any way after the first call to - Freeze(). + Type codes used to encode types of primitive values in Custom Attribute value blob. - + - Returns a NamespaceData that represents this NamespaceDataBuilder instance. After calling - this method, it is an error to use any methods or fields except Freeze() on the target - NamespaceDataBuilder. + Returns a handle to corresponding to this handle. + + The resulting handle is only valid within the context of a open on the Portable PDB blob, + which in case of standalone PDB file is a different reader than the one containing this method definition. + - + - Returns field offset for given field RowId, or -1 if not available. + #UserString heap handle. + + The handle is 32-bit wide. + - + - In CLI metadata equal to the actual number of entries in AssemblyRef table. - In WinMD metadata it includes synthesized AssemblyRefs in addition. + A handle that represents a namespace definition. @@ -1284,7 +2635,7 @@ Reads a string encoded as a compressed integer containing its length followed by its contents in UTF8. Null strings are encoded as a single 0xFF byte. - Defined as a 'SerString' in the Ecma CLI specification. + Defined as a 'SerString' in the ECMA CLI specification. String value or null. If the encoding is invalid. @@ -1361,263 +2712,184 @@ Corresponds to Value field of CustomAttribute table in ECMA-335 Standard. - + + + Decodes the arguments encoded in the value blob. + + + Represents the shape of an array type. - + Gets the number of dimensions in the array. - + Gets the sizes of each dimension. Length may be smaller than rank, in which case the trailing dimensions have unspecified sizes. - + Gets the lower-bounds of each dimension. Length may be smaller than rank, in which case the trailing dimensions have unspecified lower bounds. - + Gets the type symbol for a single-dimensional array with zero lower bounds of the given element type. - + Gets the a type symbol for the function pointer type of the given method signature. - + Gets the type symbol for the generic method parameter at the given zero-based index. - + Gets the type symbol for the generic type parameter at the given zero-based index. - + Gets the type symbol for a type with a custom modifier applied. - The metadata reader that was passed to the . It may be null. + The metadata reader that was passed to the . It may be null. True if the modifier is required, false if it's optional. The modifier type applied. The type symbol of the underlying type without modifiers applied. - + Gets the type symbol for a local variable type that is marked as pinned. - + Gets the type symbol for a type definition. - The metadata reader that was passed to the. It may be null. + The metadata reader that was passed to the signature decoder. It may be null. The type definition handle. - - When is used indicates whether - the type reference is to class or value type. Otherwise - will be passed. + + The kind of the type as specified in the signature. To interpret this value use + Note that when the signature comes from a WinMD file additional processing is needed to determine whether the target type is a value type or a reference type. - + Gets the type symbol for a type reference. - The metadata reader that was passed to the . It may be null. + The metadata reader that was passed to the signature decoder. It may be null. The type definition handle. - - When is used indicates whether - the type reference is to class or value type. Otherwise - will be passed. + + The kind of the type as specified in the signature. To interpret this value use + Note that when the signature comes from a WinMD file additional processing is needed to determine whether the target type is a value type or a reference type. - + Gets the type symbol for a type specification. - The metadata reader that was passed to the . It may be null. + The metadata reader that was passed to the signature decoder. It may be null. The type specification handle. - - When is used indicates whether - the type reference is to class or value type. Otherwise - will be passed. + + The kind of the type as specified in the signature. To interpret this value use + Note that when the signature comes from a WinMD file additional processing is needed to determine whether the target type is a value type or a reference type. - + It is not known in the current context if the type reference or definition is a class or value type. - This will be the case when is not specified. - + The type definition or reference refers to a class. - + The type definition or reference refers to a value type. - + Gets the type symbol for a primitive type. - + Gets the type symbol for a generic instantiation of the given generic type with the given type arguments. - + Gets the type symbol for a generalized array of the given element type and shape. - - - Gets the type symbol for a managed pointer to the given element type. - - - - - Gets the type symbol for an unmanaged pointer to the given element ty - - - - - Decodes signature blobs. - See Metadata Specification section II.23.2: Blobs and signatures. - - - - - Creates a new SignatureDecoder. - - The provider used to obtain type symbols as the signature is decoded. - - The metadata reader from which the signature was obtained. It may be null if the given provider allows it. - However, if is specified, it should - be non-null to evaluate WinRT projections from class to value type or vice-versa correctly. - - Set of optional decoder features to enable. - - - - Decodes a type embedded in a signature and advances the reader past the type. - - The blob reader positioned at the leading SignatureTypeCode - Allow a to follow a (CLASS | VALUETYPE) in the signature. - At present, the only context where that would be valid is in a LocalConstantSig as defined by the Portable PDB specification. - - The decoded type. - The reader was not positioned at a valid signature type. - - - - Decodes a list of types, with at least one instance that is preceded by its count as a compressed integer. - - - - - Decodes a method (definition, reference, or standalone) or property signature blob. - - BlobReader positioned at a method signature. - The decoded method signature. - The method signature is invalid. - - - - Decodes a method specification signature blob and advances the reader past the signature. - - A BlobReader positioned at a valid method specification signature. - The types used to instantiate a generic method via the method specification. - - - - Decodes a local variable signature blob and advances the reader past the signature. - - The blob reader positioned at a local variable signature. - The local variable types. - The local variable signature is invalid. - - - - Decodes a field signature blob and advances the reader past the signature. - - The blob reader positioned at a field signature. - The decoded field type. - - + - Disable all options (default when no options are passed). + Gets the type symbol for a managed pointer to the given element type. - + - Causes the decoder to pass or - to the instead of . + Gets the type symbol for an unmanaged pointer to the given element ty - - There is additional overhead for this case when dealing with .winmd files to handle projection. - Most scenarios will end up resolving valuetype vs. class from the actual definitions and do not - need to know which was used in the signature. As such, it is not enabled by default. - - + Represents a method (definition, reference, or standalone) or property signature. In the case of properties, the signature matches that of a getter with a distinguishing . - + Represents the information in the leading byte of the signature (kind, calling convention, flags). - + Gets the method's return type. - + - Gets the number of parameters that are required. Will be equal to the length of + Gets the number of parameters that are required. Will be equal to the length of unless this signature represents the standalone call site of a vararg method, in which case the entries - extra entries in are the types used for the optional parameters. + extra entries in are the types used for the optional parameters. - + Gets the number of generic type parameters of the method. Will be 0 for non-generic methods. - + Gets the method's parameter types. - + Represents a primitive type found in metadata signatures. @@ -1834,42 +3106,6 @@ Value stored in a concrete entity handle (see , , etc.). - - - Represents a metadata entity (type reference/definition/specification, method definition, custom attribute, etc.). - - - Use to store multiple kinds of entity handles. - It has smaller memory footprint than . - - - - - Value stored in a specific entity handle (see , , etc.). - - - - - Returns a handle to corresponding to this handle. - - - The resulting handle is only valid within the context of a open on the Portable PDB blob, - which in case of standalone PDB file is a different reader than the one containing this method definition. - - - - - #UserString heap handle. - - - The handle is 32-bit wide. - - - - - A handle that represents a namespace definition. - - The interface that is implemented @@ -2004,6 +3240,10 @@ Use to obtain metadata from a PE image. + is not positive. + is null. + The encoding of is not . + The current platform is big-endian. @@ -2020,12 +3260,12 @@ Looks like this function reads beginning of the header described in - Ecma-335 24.2.1 Metadata root + ECMA-335 24.2.1 Metadata root - Reads stream headers described in Ecma-335 24.2.2 Stream header + Reads stream headers described in ECMA-335 24.2.2 Stream header @@ -2033,11 +3273,46 @@ A row count for each possible table. May be indexed by . + + + Pointer to the underlying data. + + + + + Length of the underlying data. + + + + + Options passed to the constructor. + + + + + Version string read from metadata header. + + Information decoded from #Pdb stream, or null if the stream is not present. + + + The kind of the metadata (plain ECMA335, WinMD, etc.). + + + + + Comparer used to compare strings stored in metadata. + + + + + Returns true if the metadata represent an assembly. + + Returns an array of types nested in the specified type. @@ -2224,11 +3499,38 @@ Gets all exported types that reside directly in a namespace. + + + Source document in debug metadata. + + + See also https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#document-table-0x30. + + Returns Document Name Blob. + + + Source code language (C#, VB, F#, etc.) + + + + + Hash algorithm used to calculate (SHA1, SHA256, etc.) + + + + + Document content hash. + + + determines the algorithm used to produce this hash. + The source document is hashed in its binary form as stored in the file. + + representing a blob on #Blob heap in Portable PDB @@ -2251,11 +3553,51 @@ Invalid blob format. + + + Local constant. Stored in debug metadata. + + + See https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#localconstant-table-0x34. + + The constant signature. + + + Lexical scope within which a group of imports are available. Stored in debug metadata. + + + See https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#importscope-table-0x35 + + + + + Scope of local variables and constants. Stored in debug metadata. + + + See https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#localscope-table-0x32. + + + + + Local variable. Stored in debug metadata. + + + See https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#localvariable-table-0x33. + + + + + Debug information associated with a method definition. Stored in debug metadata. + + + See https://github.com/dotnet/corefx/blob/master/src/System.Reflection.Metadata/specs/PortablePdb-Metadata.md#methoddebuginformation-table-0x31. + + Returns a blob encoding sequence points. @@ -2285,6 +3627,7 @@ is null. The body is not found in the metadata or is invalid. Section where the method is stored is not available. + IO error while reading from the underlying stream. @@ -2293,6 +3636,9 @@ The caller must keep the alive and undisposed throughout the lifetime of the metadata reader. + is null + The current platform is big-endian. + IO error while reading from the underlying stream. @@ -2301,6 +3647,9 @@ The caller must keep the alive and undisposed throughout the lifetime of the metadata reader. + is null + The current platform is big-endian. + IO error while reading from the underlying stream. @@ -2309,6 +3658,15 @@ The caller must keep the alive and undisposed throughout the lifetime of the metadata reader. + is null + The encoding of is not . + The current platform is big-endian. + IO error while reading from the underlying stream. + + + + Type codes used to encode types of values in Custom Attribute value blob. + @@ -2757,27 +4115,21 @@ - Metadata - Managed Resource Data - Strong Name Signature - - Debug Table + - Debug Data (directory and extra info) - Import Table - Name Table - Runtime Startup Stub - Mapped Field Data - - - Total size of metadata (header and all streams). - - The size of IL stream (unaligned). - + - The size of mapped field data stream. - Aligned to . + Total size of metadata (header and all streams). @@ -2791,36 +4143,29 @@ Size of strong name hash. - - - If set, the module must include a machine code stub that transfers control to the virtual execution system. - - - + - If set, the module contains instructions that assume a 64 bit instruction set. For example it may depend on an address being 64 bits. - This may be true even if the module contains only IL instructions because of PlatformInvoke and COM interop. + Size of Debug data. - + - The size of a single entry in the "Debug Directory (Image Only)" + The size of mapped field data stream. + Aligned to . - + - Minimal size of PDB path in Debug Directory. We pad the path to this minimal size to - allow some tools to patch the path without the need to rewrite the entire image. - This is a workaround put in place until these tools are retired. + If set, the module must include a machine code stub that transfers control to the virtual execution system. - + - The size of our debug directory: one entry for debug information, and an optional second one indicating - that the timestamp is deterministic (i.e. not really a timestamp) + If set, the module contains instructions that assume a 64 bit instruction set. For example it may depend on an address being 64 bits. + This may be true even if the module contains only IL instructions because of PlatformInvoke and COM interop. - + Serializes .text section data into a specified . @@ -2829,22 +4174,94 @@ Entry point token or RVA () COR Flags (). Base address of the PE image. - containing metadata. Must be populated with data. Linked into the and can't be expanded afterwards. - containing IL stream. Must be populated with data. Linked into the and can't be expanded afterwards. - containing mapped field data. Must be populated with data. Linked into the and can't be expanded afterwards. - containing managed resource data. Must be populated with data. Linked into the and can't be expanded afterwards. - containing debug table data. Must be populated with data. Linked into the and can't be expanded afterwards. + containing metadata. Must be populated with data. Linked into the and can't be expanded afterwards. + containing IL stream. Must be populated with data. Linked into the and can't be expanded afterwards. + containing mapped field data. Must be populated with data. Linked into the and can't be expanded afterwards. + containing managed resource data. Must be populated with data. Linked into the and can't be expanded afterwards. + containing PE debug table and data. Must be populated with data. Linked into the and can't be expanded afterwards. + Blob reserved in the for strong name signature. - + - Write one entry in the "Debug Directory (Image Only)" - See https://msdn.microsoft.com/en-us/windows/hardware/gg463119.aspx - section 5.1.1 (pages 71-72). + Serialize the Debug Table and Data. + Builder. + The containing PE section location. + Offset of the table within the containing section. + + + + Aka IMAGE_DIRECTORY_ENTRY_EXPORT. + + + + + Aka IMAGE_DIRECTORY_ENTRY_IMPORT. + + + + + Aka IMAGE_DIRECTORY_ENTRY_RESOURCE. + + + + + Aka IMAGE_DIRECTORY_ENTRY_EXCEPTION. + + + + + Aka IMAGE_DIRECTORY_ENTRY_BASERELOC. + + + + + Aka IMAGE_DIRECTORY_ENTRY_DEBUG. + + + + + Aka IMAGE_DIRECTORY_ENTRY_COPYRIGHT or IMAGE_DIRECTORY_ENTRY_ARCHITECTURE. + + + + + Aka IMAGE_DIRECTORY_ENTRY_GLOBALPTR. + + + + + Aka IMAGE_DIRECTORY_ENTRY_TLS. + - + + + Aka IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG. + + + + + Aka IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT. + + + + + Aka IMAGE_DIRECTORY_ENTRY_IAT. + + + + + Aka IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT. + + + + + Aka IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR. + + + - Write the entire "Debug Directory (Image Only)" along with data that it points to. + Base class for PE resource section builder. Implement to provide serialization logic for native resources. @@ -3128,14 +4545,6 @@ is included in the result. - - - Resolve image size as either the given user-specified size or distance from current position to end-of-stream. - Also performs the relevant argument validation and publicly visible caller has same argument names. - - size is null and distance from current position to end-of-stream can't fit in Int32. - Size is negative or extends past the end-of-stream from current position. - Reserved. @@ -3341,12 +4750,86 @@ The number of data-directory entries in the remainder of the . Each describes a location and size. + + + Aka IMAGE_DIRECTORY_ENTRY_EXPORT. + + + + + Aka IMAGE_DIRECTORY_ENTRY_IMPORT. + + + + + Aka IMAGE_DIRECTORY_ENTRY_RESOURCE. + + + + + Aka IMAGE_DIRECTORY_ENTRY_EXCEPTION. + + The Certificate Table entry points to a table of attribute certificates. - These certificates are not loaded into memory as part of the image. - As such, the first field of this entry, which is normally an RVA, is a file pointer instead. + + These certificates are not loaded into memory as part of the image. + As such, the first field of this entry, which is normally an RVA, is a file pointer instead. + + Aka IMAGE_DIRECTORY_ENTRY_SECURITY. + + + + + Aka IMAGE_DIRECTORY_ENTRY_BASERELOC. + + + + + Aka IMAGE_DIRECTORY_ENTRY_DEBUG. + + + + + Aka IMAGE_DIRECTORY_ENTRY_COPYRIGHT or IMAGE_DIRECTORY_ENTRY_ARCHITECTURE. + + + + + Aka IMAGE_DIRECTORY_ENTRY_GLOBALPTR. + + + + + Aka IMAGE_DIRECTORY_ENTRY_TLS. + + + + + Aka IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG. + + + + + Aka IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT. + + + + + Aka IMAGE_DIRECTORY_ENTRY_IAT. + + + + + Aka IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT. + + + + + Aka IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR. + @@ -3443,12 +4926,11 @@ - Gets the offset (in bytes) from the start of the image to the given directory entry. + Gets the offset (in bytes) from the start of the image to the given directory data. - - - The section containing the directory could not be found. - The section containing the + PE directory entry + Offset from the start of the image to the given directory data + True if the directory data is found, false otherwise. @@ -3460,6 +4942,38 @@ or -1 if there is none. + + + Pointer to the first byte of the block. + + + + + Length of the block. + + + + + Creates for a blob spanning the entire block. + + + + + Creates for a blob spanning a part of the block. + + Specified range is not contained within the block. + + + + Reads the content of the entire block into an array. + + + + + Reads the content of a part of the block into an array. + + Specified range is not contained within the block. + Portable Executable format reader. @@ -3489,9 +5003,6 @@ PE image stream. is null. - - is specified and the PE headers of the image are invalid. - Ownership of the stream is transferred to the upon successful validation of constructor arguments. It will be disposed by the and the caller must not manipulate it. @@ -3545,6 +5056,7 @@ after construction. Size is negative or extends past the end of the stream. + Error reading from the stream (only when prefetching data). @@ -3571,6 +5083,13 @@ Gets the PE headers. The headers contain invalid data. + Error reading from the stream. + + + Error reading from the stream. + + + Error reading from the stream. @@ -3578,6 +5097,12 @@ PE image not available. + + IO error while reading from the underlying stream. + + + IO error while reading from the underlying stream. + Return true if the reader can access the entire PE image. @@ -3597,6 +5122,7 @@ Returns true if the PE image contains CLI metadata. The PE headers contain invalid data. + Error reading from the underlying stream. @@ -3604,6 +5130,7 @@ The PE image doesn't contain metadata ( returns false). The PE headers contain invalid data. + IO error while reading from the underlying stream. @@ -3615,19 +5142,22 @@ An empty block if doesn't represent a location in any of the PE sections of this PE image. The PE headers contain invalid data. + IO error while reading from the underlying stream. Reads all Debug Directory table entries. Bad format of the entry. + IO error while reading from the underlying stream. - Reads the data pointed to by the specifed Debug Directory entry and interprets them as CodeView. + Reads the data pointed to by the specified Debug Directory entry and interprets them as CodeView. is not a CodeView entry. Bad format of the data. + IO error while reading from the underlying stream. diff --git a/tests/scripts/compiler-perf-bigfiles.cmd b/tests/scripts/compiler-perf-bigfiles.cmd new file mode 100644 index 00000000000..312befdf033 --- /dev/null +++ b/tests/scripts/compiler-perf-bigfiles.cmd @@ -0,0 +1,23 @@ +setlocal + +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\libtest\test.fsx 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\printf\test.fsx 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\members\basics-hw\test.fsx 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\members\basics-hw-mutrec\test.fs 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\tools\eval\test.fsx 2>> log.err 1>> log.out + +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\libtest\test.fsx 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\printf\test.fsx 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\members\basics-hw\test.fsx 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\members\basics-hw-mutrec\test.fs 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\tools\eval\test.fsx 2>> log.err 1>> log.out + +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\libtest\test.fsx 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\printf\test.fsx 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\members\basics-hw\test.fsx 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\core\members\basics-hw-mutrec\test.fs 2>> log.err 1>> log.out +Release\net40\bin\fsc.exe /out:tmp.dll %* tests\fsharp\tools\eval\test.fsx 2>> log.err 1>> log.out + +REM compiler-perf-bigfiles.log + +endlocal diff --git a/tests/scripts/compiler-perf-results.txt b/tests/scripts/compiler-perf-results.txt new file mode 100644 index 00000000000..ba61fa3c11e --- /dev/null +++ b/tests/scripts/compiler-perf-results.txt @@ -0,0 +1,20 @@ +url ref sha base build startup-to-parseonly parseonly-to-check check-to-nooptimize check-to-optimize nooptimize-to-debug +https://github.com/Microsoft/visualfsharp master 0247247d480340c27ce7f7de9b2fbc3b7c598b03 0247247d480340c27ce7f7de9b2fbc3b7c598b03 208.37 10.80 30.96 46.90 64.63 52.79 +https://github.com/Microsoft/visualfsharp master 0247247d480340c27ce7f7de9b2fbc3b7c598b03 0247247d480340c27ce7f7de9b2fbc3b7c598b03 205.30 10.95 31.27 47.89 63.56 51.45 +https://github.com/Microsoft/visualfsharp master 0247247d480340c27ce7f7de9b2fbc3b7c598b03 0247247d480340c27ce7f7de9b2fbc3b7c598b03 207.75 11.09 30.23 50.55 64.30 50.56 +https://github.com/Microsoft/visualfsharp master 0247247d480340c27ce7f7de9b2fbc3b7c598b03 0247247d480340c27ce7f7de9b2fbc3b7c598b03 206.02 11.31 32.09 47.31 63.09 51.53 +https://github.com/Microsoft/visualfsharp master 1ce06f8a8e44e81e1b51ce1a4743514afda5848a 1ce06f8a8e44e81e1b51ce1a4743514afda5848a 207.13 11.30 30.84 47.05 62.64 51.97 +https://github.com/Microsoft/visualfsharp master 1ce06f8a8e44e81e1b51ce1a4743514afda5848a 1ce06f8a8e44e81e1b51ce1a4743514afda5848a 207.67 10.91 31.11 47.59 61.90 52.41 + +https://github.com/forki/visualfsharp.git foreach_optimization d0ab5fec77482e1280578f47e3257cf660d7f1b2 0247247d480340c27ce7f7de9b2fbc3b7c598b03 206.56 11.02 30.55 47.72 62.52 52.96 +https://github.com/forki/visualfsharp.git foreach_optimization d0ab5fec77482e1280578f47e3257cf660d7f1b2 0247247d480340c27ce7f7de9b2fbc3b7c598b03 206.41 10.72 31.05 48.59 61.88 53.13 +https://github.com/forki/visualfsharp.git foreach_optimization d0ab5fec77482e1280578f47e3257cf660d7f1b2 0247247d480340c27ce7f7de9b2fbc3b7c598b03 207.31 10.91 31.03 46.78 62.39 52.11 +https://github.com/forki/visualfsharp.git foreach_optimization d0ab5fec77482e1280578f47e3257cf660d7f1b2 0247247d480340c27ce7f7de9b2fbc3b7c598b03 211.23 11.36 31.42 47.38 63.22 53.54 + +https://github.com/dsyme/visualfsharp.git no-casts 53d633d6dba0d8f5fcd80f47f588d21cd7a2cff9 0247247d480340c27ce7f7de9b2fbc3b7c598b03 211.45 11.14 30.25 45.66 61.73 53.84 +https://github.com/dsyme/visualfsharp.git no-casts 53d633d6dba0d8f5fcd80f47f588d21cd7a2cff9 0247247d480340c27ce7f7de9b2fbc3b7c598b03 207.08 10.69 31.23 46.47 61.97 52.14 +https://github.com/dsyme/visualfsharp.git no-casts 53d633d6dba0d8f5fcd80f47f588d21cd7a2cff9 0247247d480340c27ce7f7de9b2fbc3b7c598b03 208.58 11.25 31.70 47.69 63.06 52.61 +https://github.com/dsyme/visualfsharp.git no-casts 53d633d6dba0d8f5fcd80f47f588d21cd7a2cff9 1ce06f8a8e44e81e1b51ce1a4743514afda5848a 209.92 10.83 30.59 46.45 63.41 55.14 +https://github.com/dsyme/visualfsharp.git no-casts 53d633d6dba0d8f5fcd80f47f588d21cd7a2cff9 1ce06f8a8e44e81e1b51ce1a4743514afda5848a 230.10 11.06 29.59 46.61 64.58 54.09 +https://github.com/dsyme/visualfsharp.git no-casts 53d633d6dba0d8f5fcd80f47f588d21cd7a2cff9 1ce06f8a8e44e81e1b51ce1a4743514afda5848a 221.48 12.05 31.19 47.31 62.44 54.08 +https://github.com/Microsoft/visualfsharp master 1ce06f8a8e44e81e1b51ce1a4743514afda5848a 1ce06f8a8e44e81e1b51ce1a4743514afda5848a 213.58 11.23 32.03 47.61 62.34 51.25 diff --git a/tests/scripts/compiler-perf.fsx b/tests/scripts/compiler-perf.fsx new file mode 100644 index 00000000000..309b3e5294f --- /dev/null +++ b/tests/scripts/compiler-perf.fsx @@ -0,0 +1,141 @@ + +#if FETCH_PACKAGES +open System +open System.IO + +Environment.CurrentDirectory <- __SOURCE_DIRECTORY__ + +if not (File.Exists "paket.exe") then let url = "https://github.com/fsprojects/Paket/releases/download/3.4.0/paket.exe" in use wc = new Net.WebClient() in let tmp = Path.GetTempFileName() in wc.DownloadFile(url, tmp); File.Move(tmp,Path.GetFileName url);; + +// Step 1. Resolve and install the packages + +#r "paket.exe" + +if not (Directory.Exists "script-packages") then Directory.CreateDirectory("script-packages") |> ignore +Paket.Dependencies.Install(""" +source https://nuget.org/api/v2 +nuget FSharp.Data +nuget FAKE +""","script-packages");; + +#else + + + +#I "script-packages/packages/FAKE/tools" +#I "script-packages/packages/FSharp.Data/lib/net40" +#r "script-packages/packages/FAKE/tools/FakeLib.dll" +#r "script-packages/packages/FSharp.Data/lib/net40/FSharp.Data.dll" + +open System +open System.IO +open Fake +open Fake.Git +open FSharp.Data + +Fake.Git.Information.describe + +[] +let repo = "https://github.com/Microsoft/visualfsharp" +[] +let repoApi = "https://api.github.com/repos/Microsoft/visualfsharp" +type Commits = JsonProvider< const (repoApi + "/commits")> + +type Pulls = JsonProvider< const (repoApi + "/pulls")> + +//type Comments = JsonProvider< "https://api.github.com/repos/Microsoft/visualfsharp/issues/848/comments"> +//let comments = Comments.GetSamples() + +let commits = Commits.GetSamples() +let pulls = Pulls.GetSamples() + +let repoHeadSha = commits.[0].Sha + +// Do performance testing on all open PRs that have [CompilerPerf] in the title +let buildSpecs = + [ for pr in pulls do + //let comments = Comments.Load(pr.CommentsUrl) + if pr.Title.Contains("[CompilerPerf]") then + yield (pr.Head.Repo.CloneUrl, pr.Head.Sha, repoHeadSha, pr.Head.Ref, pr.Number) + // ("https://github.com/dsyme/visualfsharp.git","53d633d6dba0d8f5fcd80f47f588d21cd7a2cff9", repoHeadSha, "no-casts", 1308); + //yield ("https://github.com/forki/visualfsharp.git", "d0ab5fec77482e1280578f47e3257cf660d7f1b2", repoHeadSha, "foreach_optimization", 1303); + yield (repo, repoHeadSha, repoHeadSha, "master", 0); + ] + + +let time f = + let start = DateTime.UtcNow + let res = f() + let finish = DateTime.UtcNow + res, finish - start + + +let exec cmd args dir = + printfn "%s> %s %s" dir cmd args + let result = Shell.Exec(cmd,args,dir) + if result <> 0 then failwith (sprintf "FAILED: %s> %s %s" dir cmd args) + +/// Build a specific version of the repo, run compiler perf tests and record the result +let build(cloneUrl,sha:string,baseSha,ref,prNumber) = + let branch = "build-" + string prNumber + "-" + ref + "-" + sha.[0..7] + let dirBase = __SOURCE_DIRECTORY__ + let dirBuild = "current" + let dir = Path.Combine(dirBase, dirBuild) // "build-" + ref + "-" + sha.[0..7] + //printfn "cloning %s branch %s into %s" cloneUrl ref dir + if not (Directory.Exists dir) then + exec "git" ("clone " + repo + " " + dirBuild) dirBase |> ignore + let result = exec "git" "reset --merge" dir + let result = exec "git" "checkout master" dir + let result = exec "git" "clean -f -x" dir + let result = exec "git" ("checkout -B " + branch + " master") dir + let result = exec "git" ("pull " + cloneUrl + " " + ref) dir + let result, buildTime = time (fun () -> exec "cmd" "/C build.cmd release proto net40 notests" dir ) + let result, ngenTime = time (fun () -> exec "ngen" @"install Release\net40\bin\fsc.exe" dir ) + + let runPhase (test:string) (flags:string)= + printfn "copying compiler-perf-%s.cmd to %s" test dir + File.Copy(sprintf "compiler-perf-%s.cmd" test,Path.Combine(dir,sprintf "compiler-perf-%s.cmd" test),true) + printfn "running compiler-perf-%s.cmd in %s" test dir + let result, time = time (fun () -> exec "cmd" (sprintf "/C compiler-perf-%s.cmd %s" test flags) dir ) + //File.Copy(Path.Combine(dir,sprintf "compiler-perf-%s.log" test),Path.Combine(dirBase,sprintf "compiler-perf-%s-%s.log" test branch),true) + time.TotalSeconds + + let runScenario name = + + let parseonly = runPhase name "/parseonly" + let checkonly = runPhase name "/typecheckonly" + let nooptimize = runPhase name "/optimize- /debug-" + let debug = runPhase name "/optimize- /debug+" + let optimize = runPhase name "/optimize+ /debug-" + + let times = + [ (sprintf "%s-startup-to-parseonly" name, parseonly) + (sprintf "%s-parseonly-to-checkonly" name, checkonly - parseonly) + (sprintf "%s-checkonly-to-nooptimize" name, nooptimize - checkonly) + (sprintf "%s-checkonly-to-optimize" name, optimize - checkonly) + (sprintf "%s-nooptimize-to-debug" name, debug - nooptimize) ] + + let timesHeaderText = (String.concat " " (List.map fst times)) + let timesText = (times |> List.map snd |> List.map (sprintf "%0.2f ") |> String.concat " ") + timesHeaderText, timesText + + let timesHeaderText, timesText = runScenario "bigfiles" + + let logFile = "compiler-perf-results.txt" + let logHeader = sprintf "url ref sha base build %s" timesHeaderText + let logLine = sprintf "%s %s %s %s %0.2f %s" cloneUrl ref sha baseSha buildTime.TotalSeconds timesText + let existing = if File.Exists logFile then File.ReadAllLines(logFile) else [| logHeader |] + printfn "writing results %s" logLine + + File.WriteAllLines(logFile, [| yield! existing; yield logLine |]) + () + + +for info in buildSpecs do + try + build info + with e -> + printfn "ERROR: %A - %s" info e.Message + + +#endif diff --git a/vsintegration/VisualFSharpVsix/RegisterFsharpPackage.pkgdef b/vsintegration/Vsix/RegisterFsharpPackage.pkgdef similarity index 100% rename from vsintegration/VisualFSharpVsix/RegisterFsharpPackage.pkgdef rename to vsintegration/Vsix/RegisterFsharpPackage.pkgdef diff --git a/vsintegration/Vsix/VisualFSharpDesktop/Source.extension.vsixmanifest b/vsintegration/Vsix/VisualFSharpDesktop/Source.extension.vsixmanifest new file mode 100644 index 00000000000..3d5595153ac --- /dev/null +++ b/vsintegration/Vsix/VisualFSharpDesktop/Source.extension.vsixmanifest @@ -0,0 +1,61 @@ + + + + + + Visual F# Tools + Deploy Visual F# Tools templates to Visual Studio + ..\CommonExtensions\Microsoft\FSharp + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/vsintegration/Vsix/VisualFSharpDesktop/VisualFSharpDesktop.csproj b/vsintegration/Vsix/VisualFSharpDesktop/VisualFSharpDesktop.csproj new file mode 100644 index 00000000000..ba7bb5a7f2c --- /dev/null +++ b/vsintegration/Vsix/VisualFSharpDesktop/VisualFSharpDesktop.csproj @@ -0,0 +1,276 @@ + + + + + ..\..\..\src + net40 + 15.0 + 11.0 + $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion) + + + 15.0 + 2.0 + true + {82b43b9b-a64c-4715-b499-d71e9ca2bd60};{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC} + + + publish\ + true + Disk + false + Foreground + 7 + Days + true + false + true + 0 + v4.6 + false + false + false + false + false + false + false + false + true + None + Debug + AnyCPU + Library + Properties + FSharpDev + true + False + True + {E7EC4A3E-9D57-45B8-83F5-EDDFD6CEF090} + true + VisualFSharpDesktop + $(FSharpSourcesRoot)\..\$(Configuration)\$(TargetFramework)\bin + VisualFSharpDesktop + $(RootBinPath) + 15.4.1.0 + cs + + + Program + $(DevEnvDir)devenv.exe + /rootsuffix $(VSRootSuffix) /log + $(VSRootSuffix) + true + + + Program + $(DevEnvDir)devenv.exe + true + /rootsuffix $(VSRootSuffix) /log + $(VSRootSuffix) + + + + Designer + + + Always + true + RegisterFsharpPackage.pkgdef + + + PreserveNewest + true + + + + + False + Microsoft .NET Framework 4.6 %28x86 and x64%29 + true + + + False + .NET Framework 3.5 SP1 Client Profile + false + + + False + .NET Framework 3.5 SP1 + false + + + + + {649FA588-F02E-457C-9FCF-87E46407481E} + FSharp.Compiler.Interactive.Settings + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {D5870CF0-ED51-4CBC-B3D7-6F56DA84AC06} + FSharp.Compiler.Server.Shared + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3} + FSharp.Compiler + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {DED3BBD7-53F4-428A-8C9F-27968E768605} + FSharp.Core + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + + + {A437A6EC-5323-47C2-8F86-E2CAC54FF152} + FSharp.LanguageService.Compiler + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {8B3E283D-B5FE-4055-9D80-7E3A32F3967B} + FsiAnyCPU + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {D0E98C0D-490B-4C61-9329-0862F6E87645} + Fsi + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {65e0e82a-eace-4787-8994-888674c2fe87} + FSharp.Editor + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {1C5C163C-37EA-4A3C-8CCC-0D34B74BF8EF} + FSharp.LanguageService.Base + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {EE85AAB7-CDA0-4C4E-BDA0-A64CCC413E3F} + FSharp.LanguageService + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {B700E38B-F8C0-4E49-B5EC-DB7B7AC0C4E7} + ProjectSystem.Base + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {6196B0F8-CAEA-4CF1-AF82-1B520F77FE44} + ProjectSystem + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {FCFB214C-462E-42B3-91CA-FC557EFEE74F} + FSharp.PropertiesPages + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {991DCF75-C2EB-42B6-9A0D-AA1D2409D519} + FSharp.VS.FSI + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {6ba13aa4-c25f-480f-856b-8e8000299a72} + AppConfig + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {12ac2813-e895-4aaa-ae6c-94e21da09f64} + CodeFile + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {a333b85a-dc23-49b6-9797-b89a7951e92d} + ScriptFile + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {e3fdd4ac-46b6-4b9f-b672-317d1202cc50} + SignatureFile + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {d11fc318-8f5d-4c8c-9287-ab40a016d13c} + TextFile + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {1fb1dd07-06aa-45b4-b5ac-20ff5bee98b6} + XMLFile + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {604f0daa-2d33-48dd-b162-edf0b672803d} + ConsoleProject + ProjectTemplates + false + TemplateProjectOutputGroup%3b + + + {01678cda-a11f-4dee-9344-2edf91cf1ae7} + LibraryProject + ProjectTemplates + false + TemplateProjectOutputGroup%3b + + + {2facee44-48bd-40b5-a2ee-b54a0c9bb7c4} + TutorialProject + ProjectTemplates + false + TemplateProjectOutputGroup%3b + + + + + + + + + + + VsixSHA2 + + + + \ No newline at end of file diff --git a/vsintegration/VisualFSharpVsix/Source.extension.vsixmanifest b/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest similarity index 97% rename from vsintegration/VisualFSharpVsix/Source.extension.vsixmanifest rename to vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest index d071c01451b..d18aef7d899 100644 --- a/vsintegration/VisualFSharpVsix/Source.extension.vsixmanifest +++ b/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest @@ -60,5 +60,7 @@ + + \ No newline at end of file diff --git a/vsintegration/VisualFSharpVsix/VisualFSharpVsix.csproj b/vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj similarity index 84% rename from vsintegration/VisualFSharpVsix/VisualFSharpVsix.csproj rename to vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj index a7d5e161fb5..2dff395f805 100644 --- a/vsintegration/VisualFSharpVsix/VisualFSharpVsix.csproj +++ b/vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj @@ -2,8 +2,7 @@ - ..\..\src - ..\src + ..\..\..\src net40 15.0 11.0 @@ -40,18 +39,17 @@ None Debug AnyCPU - false Library Properties FSharpDev true False True - {E7EC4A3E-9D57-45B8-83F5-EDDFD6CEF090} + {59ADCE46-9740-4079-834D-9A03A3494EBC} true - VisualFSharpVsix + VisualFSharpFull $(FSharpSourcesRoot)\..\$(Configuration)\$(TargetFramework)\bin - VisualFSharpVsix + VisualFSharpFull $(RootBinPath) 15.4.1.0 cs @@ -74,7 +72,7 @@ Designer - + Always true RegisterFsharpPackage.pkgdef @@ -150,147 +148,147 @@ DebugSymbolsProjectOutputGroup%3b false - + {65e0e82a-eace-4787-8994-888674c2fe87} FSharp.Editor BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b DebugSymbolsProjectOutputGroup%3b false - + {1C5C163C-37EA-4A3C-8CCC-0D34B74BF8EF} FSharp.LanguageService.Base BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b DebugSymbolsProjectOutputGroup%3b false - + {EE85AAB7-CDA0-4C4E-BDA0-A64CCC413E3F} FSharp.LanguageService BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b DebugSymbolsProjectOutputGroup%3b false - + {B700E38B-F8C0-4E49-B5EC-DB7B7AC0C4E7} ProjectSystem.Base BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b DebugSymbolsProjectOutputGroup%3b false - + {6196B0F8-CAEA-4CF1-AF82-1B520F77FE44} ProjectSystem BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b DebugSymbolsProjectOutputGroup%3b false - + {FCFB214C-462E-42B3-91CA-FC557EFEE74F} FSharp.PropertiesPages BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b DebugSymbolsProjectOutputGroup%3b false - + {991DCF75-C2EB-42B6-9A0D-AA1D2409D519} FSharp.VS.FSI BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b DebugSymbolsProjectOutputGroup%3b false - + {6ba13aa4-c25f-480f-856b-8e8000299a72} AppConfig ItemTemplates false TemplateProjectOutputGroup%3b - + {12ac2813-e895-4aaa-ae6c-94e21da09f64} CodeFile ItemTemplates false TemplateProjectOutputGroup%3b - + {a333b85a-dc23-49b6-9797-b89a7951e92d} ScriptFile ItemTemplates false TemplateProjectOutputGroup%3b - + {e3fdd4ac-46b6-4b9f-b672-317d1202cc50} SignatureFile ItemTemplates false TemplateProjectOutputGroup%3b - + {d11fc318-8f5d-4c8c-9287-ab40a016d13c} TextFile ItemTemplates false TemplateProjectOutputGroup%3b - + {1fb1dd07-06aa-45b4-b5ac-20ff5bee98b6} XMLFile ItemTemplates false TemplateProjectOutputGroup%3b - + {604f0daa-2d33-48dd-b162-edf0b672803d} ConsoleProject ProjectTemplates false TemplateProjectOutputGroup%3b - + {01678cda-a11f-4dee-9344-2edf91cf1ae7} LibraryProject ProjectTemplates false TemplateProjectOutputGroup%3b - + {d9d95330-3626-4199-b7af-17b8e4af6d87} NetCore259Project ProjectTemplates false TemplateProjectOutputGroup%3b - + {1a8dbf70-4178-4ae3-af5f-39ddd5692210} NetCore78Project ProjectTemplates false TemplateProjectOutputGroup%3b - + {5b739cf3-1116-4eb4-b598-6c16bea81ce5} NetCoreProject ProjectTemplates false TemplateProjectOutputGroup%3b - + {db374a0c-7560-479f-9b21-d37c81f7624f} PortableLibraryProject ProjectTemplates false TemplateProjectOutputGroup%3b - + {15a57828-f9f5-4fb4-8e1e-ae7622a10f70} SilverlightProject ProjectTemplates false TemplateProjectOutputGroup%3b - + {2facee44-48bd-40b5-a2ee-b54a0c9bb7c4} TutorialProject ProjectTemplates @@ -298,6 +296,14 @@ TemplateProjectOutputGroup%3b - + + + + + + VsixSHA2 + + + \ No newline at end of file diff --git a/vsintegration/Vsix/VisualFSharpWeb/Source.extension.vsixmanifest b/vsintegration/Vsix/VisualFSharpWeb/Source.extension.vsixmanifest new file mode 100644 index 00000000000..3350baf4e51 --- /dev/null +++ b/vsintegration/Vsix/VisualFSharpWeb/Source.extension.vsixmanifest @@ -0,0 +1,60 @@ + + + + + + Visual F# Tools + Deploy Visual F# Tools templates to Visual Studio + ..\CommonExtensions\Microsoft\FSharp + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/vsintegration/Vsix/VisualFSharpWeb/VisualFSharpWeb.csproj b/vsintegration/Vsix/VisualFSharpWeb/VisualFSharpWeb.csproj new file mode 100644 index 00000000000..676aab3a6a1 --- /dev/null +++ b/vsintegration/Vsix/VisualFSharpWeb/VisualFSharpWeb.csproj @@ -0,0 +1,274 @@ + + + + + ..\..\..\src + net40 + 15.0 + 11.0 + $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion) + + + 15.0 + 2.0 + true + {82b43b9b-a64c-4715-b499-d71e9ca2bd60};{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC} + + + publish\ + true + Disk + false + Foreground + 7 + Days + true + false + true + 0 + v4.6 + false + false + false + false + false + false + false + false + true + None + Debug + AnyCPU + Library + Properties + FSharpDev + true + False + True + {58730C8B-16F5-4956-9291-BB68E17C9142} + true + VisualFSharpWeb + $(FSharpSourcesRoot)\..\$(Configuration)\$(TargetFramework)\bin + VisualFSharpWeb + $(RootBinPath) + 15.4.1.0 + cs + + + Program + $(DevEnvDir)devenv.exe + /rootsuffix $(VSRootSuffix) /log + $(VSRootSuffix) + true + + + Program + $(DevEnvDir)devenv.exe + true + /rootsuffix $(VSRootSuffix) /log + $(VSRootSuffix) + + + + Designer + + + Always + true + RegisterFsharpPackage.pkgdef + + + PreserveNewest + true + + + + + False + Microsoft .NET Framework 4.6 %28x86 and x64%29 + true + + + False + .NET Framework 3.5 SP1 Client Profile + false + + + False + .NET Framework 3.5 SP1 + false + + + + + {649FA588-F02E-457C-9FCF-87E46407481E} + FSharp.Compiler.Interactive.Settings + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {D5870CF0-ED51-4CBC-B3D7-6F56DA84AC06} + FSharp.Compiler.Server.Shared + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3} + FSharp.Compiler + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {DED3BBD7-53F4-428A-8C9F-27968E768605} + FSharp.Core + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + + + {A437A6EC-5323-47C2-8F86-E2CAC54FF152} + FSharp.LanguageService.Compiler + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {8B3E283D-B5FE-4055-9D80-7E3A32F3967B} + FsiAnyCPU + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {D0E98C0D-490B-4C61-9329-0862F6E87645} + Fsi + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {65e0e82a-eace-4787-8994-888674c2fe87} + FSharp.Editor + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {1C5C163C-37EA-4A3C-8CCC-0D34B74BF8EF} + FSharp.LanguageService.Base + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {EE85AAB7-CDA0-4C4E-BDA0-A64CCC413E3F} + FSharp.LanguageService + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {B700E38B-F8C0-4E49-B5EC-DB7B7AC0C4E7} + ProjectSystem.Base + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {6196B0F8-CAEA-4CF1-AF82-1B520F77FE44} + ProjectSystem + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {FCFB214C-462E-42B3-91CA-FC557EFEE74F} + FSharp.PropertiesPages + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {991DCF75-C2EB-42B6-9A0D-AA1D2409D519} + FSharp.VS.FSI + BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bSatelliteDllsProjectOutputGroup%3bPkgDefProjectOutputGroup%3b + DebugSymbolsProjectOutputGroup%3b + false + + + {6ba13aa4-c25f-480f-856b-8e8000299a72} + AppConfig + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {12ac2813-e895-4aaa-ae6c-94e21da09f64} + CodeFile + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {a333b85a-dc23-49b6-9797-b89a7951e92d} + ScriptFile + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {e3fdd4ac-46b6-4b9f-b672-317d1202cc50} + SignatureFile + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {d11fc318-8f5d-4c8c-9287-ab40a016d13c} + TextFile + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {1fb1dd07-06aa-45b4-b5ac-20ff5bee98b6} + XMLFile + ItemTemplates + false + TemplateProjectOutputGroup%3b + + + {01678cda-a11f-4dee-9344-2edf91cf1ae7} + LibraryProject + ProjectTemplates + false + TemplateProjectOutputGroup%3b + + + {15a57828-f9f5-4fb4-8e1e-ae7622a10f70} + SilverlightProject + ProjectTemplates + false + TemplateProjectOutputGroup%3b + + + {2facee44-48bd-40b5-a2ee-b54a0c9bb7c4} + TutorialProject + ProjectTemplates + false + TemplateProjectOutputGroup%3b + + + + + + + + + VsixSHA2 + + + + \ No newline at end of file diff --git a/vsintegration/fsharp-vsintegration-vsix-build.proj b/vsintegration/fsharp-vsintegration-vsix-build.proj index 1eb3e5c22a2..96cc78da026 100644 --- a/vsintegration/fsharp-vsintegration-vsix-build.proj +++ b/vsintegration/fsharp-vsintegration-vsix-build.proj @@ -5,25 +5,12 @@ - - - - - - - - - - - - - - + + + - - diff --git a/vsintegration/src/FSharp.Editor/AssemblyInfo.fs b/vsintegration/src/FSharp.Editor/AssemblyInfo.fs index df2a6155a39..ad1a0577129 100644 --- a/vsintegration/src/FSharp.Editor/AssemblyInfo.fs +++ b/vsintegration/src/FSharp.Editor/AssemblyInfo.fs @@ -4,6 +4,8 @@ namespace Microsoft.VisualStudio.FSharp.Editor open Microsoft.VisualStudio.Shell +[] + [] do() diff --git a/vsintegration/src/FSharp.Editor/FSharpBraceMatchingService.fs b/vsintegration/src/FSharp.Editor/BraceMatchingService.fs similarity index 99% rename from vsintegration/src/FSharp.Editor/FSharpBraceMatchingService.fs rename to vsintegration/src/FSharp.Editor/BraceMatchingService.fs index 9eb172ff10c..71302f16c44 100644 --- a/vsintegration/src/FSharp.Editor/FSharpBraceMatchingService.fs +++ b/vsintegration/src/FSharp.Editor/BraceMatchingService.fs @@ -113,4 +113,4 @@ type internal FSharpBraceMatchingService() = else if braceMatchingResult.RightSpan.Start = position then Some(braceMatchingResult.LeftSpan.Start) else - None + None \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/FSharpColorizationService.fs b/vsintegration/src/FSharp.Editor/ColorizationService.fs similarity index 100% rename from vsintegration/src/FSharp.Editor/FSharpColorizationService.fs rename to vsintegration/src/FSharp.Editor/ColorizationService.fs diff --git a/vsintegration/src/FSharp.Editor/FSharpContentType.fs b/vsintegration/src/FSharp.Editor/ContentType.fs similarity index 82% rename from vsintegration/src/FSharp.Editor/FSharpContentType.fs rename to vsintegration/src/FSharp.Editor/ContentType.fs index 514bf0fcf0c..24b0b863398 100644 --- a/vsintegration/src/FSharp.Editor/FSharpContentType.fs +++ b/vsintegration/src/FSharp.Editor/ContentType.fs @@ -2,11 +2,12 @@ namespace Microsoft.VisualStudio.FSharp.Editor +open System.ComponentModel.Composition + open Microsoft.CodeAnalysis.Editor -open Microsoft.VisualStudio.FSharp.LanguageService open Microsoft.VisualStudio.Utilities -open System.ComponentModel.Composition -open System.Composition + +open Microsoft.VisualStudio.FSharp.LanguageService module FSharpStaticTypeDefinitions = [] @@ -14,11 +15,10 @@ module FSharpStaticTypeDefinitions = [] let FSharpContentTypeDefinition = ContentTypeDefinition() -[] [] -type internal FSharpContentTypeLanguageService [](contentTypeRegistry : IContentTypeRegistryService) = +type FSharpContentType [](contentTypeRegistry : IContentTypeRegistryService) = member this.contentTypeRegistryService = contentTypeRegistry interface IContentTypeLanguageService with member this.GetDefaultContentType() = - this.contentTypeRegistryService.GetContentType(FSharpCommonConstants.FSharpContentTypeName); + this.contentTypeRegistryService.GetContentType(FSharpCommonConstants.FSharpContentTypeName) diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index 77e6e04f855..a532bb5d9d2 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -5,7 +5,6 @@ ..\..\..\src FSharp true - v4.6 @@ -30,115 +29,129 @@ true - - - - - + + + + - + {DED3BBD7-53F4-428A-8C9F-27968E768605} FSharp.Core - + FSharp.LanguageService {ee85aab7-cda0-4c4e-bda0-a64ccc413e3f} True - + FSharp.LanguageService.Base {1c5c163c-37ea-4a3c-8ccc-0d34b74bf8ef} True - + {a437a6ec-5323-47c2-8f86-e2cac54ff152} FSharp.LanguageService.Compiler True - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Editor.14.2.25123\lib\net45\Microsoft.VisualStudio.Editor.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Editor.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Editor.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.UI.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.Wpf.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.UI.Wpf.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Data.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.UI.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Logic.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Logic.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.Data.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.CoreUtility.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Logic.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.Logic.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Utilities.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.14.2.25123\lib\net45\Microsoft.VisualStudio.CoreUtility.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Shell.Design.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Package.LanguageService.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Package.LanguageService.$(RoslynVSBinariesVersion).dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Language.StandardClassification.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Language.StandardClassification.dll + + + $(FSharpSourcesRoot)\..\packages\Roslyn.Microsoft.VisualStudio.ComponentModelHost.0.0.2\lib\net46\Microsoft.VisualStudio.ComponentModelHost.dll - - - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.14.2.25123\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.14.2.25123\lib\net45\Microsoft.VisualStudio.Utilities.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll - - + - - - - $(FSharpSourcesRoot)\..\packages\Microsoft.Composition.$(MicrosoftCompositionVersion)\lib\portable-net45+win8+wp8+wpa81\System.Composition.AttributedModel.dll - - - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\dotnet\System.Collections.Immutable.dll - $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Common.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Workspaces.Common.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.Workspaces.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Features.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.Features.dll + True $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.EditorFeatures.$(RoslynVersion)\lib\net46\Microsoft.CodeAnalysis.EditorFeatures.dll + True $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.EditorFeatures.Text.$(RoslynVersion)\lib\net46\Microsoft.CodeAnalysis.EditorFeatures.Text.dll + True + + + $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Features.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.Features.dll + True + + + $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Workspaces.Common.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.Workspaces.dll + True $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.LanguageServices.$(RoslynVersion)\lib\net46\Microsoft.VisualStudio.LanguageServices.dll + True + + + $(FSharpSourcesRoot)\..\packages\Microsoft.Composition.1.0.27\lib\portable-net45+win8+wp8+wpa81\System.Composition.AttributedModel.dll + True + + + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0-rc3-23805\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + True - - - + - Microsoft - StrongName + Microsoft + StrongName diff --git a/vsintegration/src/FSharp.Editor/InternalsVisibleTo.fs b/vsintegration/src/FSharp.Editor/InternalsVisibleTo.fs deleted file mode 100644 index 693a5eaa5b0..00000000000 --- a/vsintegration/src/FSharp.Editor/InternalsVisibleTo.fs +++ /dev/null @@ -1,10 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. - -namespace Microsoft.FSharp - -open System.Reflection - -[] - -do() - diff --git a/vsintegration/src/FSharp.Editor/FSharpProjectSiteService.fs b/vsintegration/src/FSharp.Editor/ProjectSiteService.fs similarity index 96% rename from vsintegration/src/FSharp.Editor/FSharpProjectSiteService.fs rename to vsintegration/src/FSharp.Editor/ProjectSiteService.fs index acd1e712205..2f0c58763d8 100644 --- a/vsintegration/src/FSharp.Editor/FSharpProjectSiteService.fs +++ b/vsintegration/src/FSharp.Editor/ProjectSiteService.fs @@ -28,4 +28,4 @@ type internal FSharpProjectSiteService [] (vsWorkspace : V interface IHostProjectService with member this.GetHostProject(id:ProjectId) = - downcast vsWorkspace.GetHostProject(id) \ No newline at end of file + downcast vsWorkspace.GetHostProject(id) diff --git a/vsintegration/src/FSharp.LanguageService.Base/FSharp.LanguageService.Base.csproj b/vsintegration/src/FSharp.LanguageService.Base/FSharp.LanguageService.Base.csproj index 622c06d519f..4e08fbb47f9 100644 --- a/vsintegration/src/FSharp.LanguageService.Base/FSharp.LanguageService.Base.csproj +++ b/vsintegration/src/FSharp.LanguageService.Base/FSharp.LanguageService.Base.csproj @@ -62,8 +62,9 @@ {991dcf75-c2eb-42b6-9a0d-aa1d2409d519} FSharp.VS.FSI - - + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + @@ -78,36 +79,55 @@ - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.14.2.25123\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.14.2.25123\lib\net45\Microsoft.VisualStudio.CoreUtility.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Editor.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Editor.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.UI.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.Wpf.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.UI.Wpf.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Data.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Logic.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Logic.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.CoreUtility.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Utilities.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.Data.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.UI.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Package.LanguageService.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Package.LanguageService.$(RoslynVSBinariesVersion).dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.Wpf.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.UI.Wpf.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Language.StandardClassification.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Language.StandardClassification.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Editor.14.2.25123\lib\net45\Microsoft.VisualStudio.Editor.dll + + $(FSharpSourcesRoot)\..\packages\Roslyn.Microsoft.VisualStudio.ComponentModelHost.0.0.2\lib\net46\Microsoft.VisualStudio.ComponentModelHost.dll - {DED3BBD7-53F4-428A-8C9F-27968E768605} FSharp.Core diff --git a/vsintegration/src/FSharp.LanguageService/FSharpCommonConstants.fs b/vsintegration/src/FSharp.LanguageService/CommonConstants.fs similarity index 77% rename from vsintegration/src/FSharp.LanguageService/FSharpCommonConstants.fs rename to vsintegration/src/FSharp.LanguageService/CommonConstants.fs index bdf6aac3bd0..62f8215ccd5 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharpCommonConstants.fs +++ b/vsintegration/src/FSharp.LanguageService/CommonConstants.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. namespace Microsoft.VisualStudio.FSharp.LanguageService @@ -18,4 +18,4 @@ module internal FSharpCommonConstants = [] let FSharpContentTypeName = "F#" [] - let FSharpLanguageServiceCallbackName = "F# Language Service" + let FSharpLanguageServiceCallbackName = "F# Language Service" \ No newline at end of file diff --git a/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj b/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj index 0b6b2a8aa95..b61fc83a585 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj +++ b/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj @@ -14,14 +14,6 @@ true true - - - $(FSharpSourcesRoot)\..\loc\lcl\{Lang}\$(AssemblyName).dll.lcl - $(FSharpSourcesRoot)\..\loc\lci\$(AssemblyName).dll.lci - false - false - - Debug AnyCPU @@ -37,12 +29,29 @@ true + + + + + + + + Microsoft + StrongName + + + + + $(FSharpSourcesRoot)\..\loc\lcl\{Lang}\$(AssemblyName).dll.lcl + $(FSharpSourcesRoot)\..\loc\lci\$(AssemblyName).dll.lci + false + false + - - + @@ -55,8 +64,8 @@ - - + + @@ -65,32 +74,18 @@ - - + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.14.2.25123\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.14.2.25123\lib\net45\Microsoft.VisualStudio.Utilities.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Package.LanguageService.14.0.14.2.25123\lib\Microsoft.VisualStudio.Package.LanguageService.14.0.dll - - - @@ -105,44 +100,43 @@ - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Logic.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.Logic.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.UI.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Editor.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Editor.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.Wpf.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.UI.Wpf.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.UI.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.14.2.25123\lib\net45\Microsoft.VisualStudio.CoreUtility.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.Wpf.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.UI.Wpf.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.Data.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Data.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Editor.14.2.25123\lib\net45\Microsoft.VisualStudio.Editor.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Logic.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Logic.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Language.StandardClassification.14.2.25123\lib\net45\Microsoft.VisualStudio.Language.StandardClassification.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.CoreUtility.dll - - - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\dotnet\System.Collections.Immutable.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Utilities.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Common.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Workspaces.Common.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.Workspaces.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Features.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.Features.dll + + $(FSharpSourcesRoot)\..\packages\Roslyn.Microsoft.VisualStudio.ComponentModelHost.0.0.2\lib\net46\Microsoft.VisualStudio.ComponentModelHost.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.LanguageServices.$(RoslynVersion)\lib\net46\Microsoft.VisualStudio.LanguageServices.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Microsoft.VisualStudio.Shell.UI.Internal.14.0.25420\lib\net45\Microsoft.VisualStudio.Shell.UI.Internal.dll - + {DED3BBD7-53F4-428A-8C9F-27968E768605} FSharp.Core @@ -163,19 +157,37 @@ FSharp.LanguageService.Compiler True + + $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Common.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.dll + True + + + $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.EditorFeatures.$(RoslynVersion)\lib\net46\Microsoft.CodeAnalysis.EditorFeatures.dll + True + + + $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.EditorFeatures.Text.$(RoslynVersion)\lib\net46\Microsoft.CodeAnalysis.EditorFeatures.Text.dll + True + + + $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Features.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.Features.dll + True + + + $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Workspaces.Common.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.Workspaces.dll + True + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.LanguageServices.$(RoslynVersion)\lib\net46\Microsoft.VisualStudio.LanguageServices.dll + True + + + $(FSharpSourcesRoot)\..\packages\Microsoft.Composition.1.0.27\lib\portable-net45+win8+wp8+wpa81\System.Composition.AttributedModel.dll + True + + + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0-rc3-23805\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + True + - - - - - - - - - - Microsoft - StrongName - - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.LanguageService/IProjectSite.fs b/vsintegration/src/FSharp.LanguageService/IProjectSite.fs index e0aff674664..4c1b250091a 100644 --- a/vsintegration/src/FSharp.LanguageService/IProjectSite.fs +++ b/vsintegration/src/FSharp.LanguageService/IProjectSite.fs @@ -20,10 +20,10 @@ type internal IProjectSite = /// Register for notifications when project is cleaned/rebuilt (and thus any live TypeProviders should be refreshed) abstract AdviseProjectSiteCleaned : (*callbackOwnerKey*)string * AdviseProjectSiteChanges -> unit - + // Register for notifications when project is closed. abstract AdviseProjectSiteClosed : (*callbackOwnerKey*)string * AdviseProjectSiteChanges -> unit - + /// A user-friendly description of the project. Used only for developer/DEBUG tooltips and such. abstract DescriptionOfProject : unit -> string diff --git a/vsintegration/src/FSharp.LanguageService/FSharpLanguageService.fs b/vsintegration/src/FSharp.LanguageService/LanguageService.fs similarity index 84% rename from vsintegration/src/FSharp.LanguageService/FSharpLanguageService.fs rename to vsintegration/src/FSharp.LanguageService/LanguageService.fs index 5c7a152a531..fa6d49eac67 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharpLanguageService.fs +++ b/vsintegration/src/FSharp.LanguageService/LanguageService.fs @@ -24,20 +24,6 @@ open Microsoft.VisualStudio.Shell.Interop type internal SVsSettingsPersistenceManager = class end [] - -[, ".fs")>] -[, ".fsi")>] -[, ".fsx")>] -[, ".fsscript")>] -[, ".ml")>] -[, ".mli")>] - -[] -[] -[] -[] -[] -[] type internal FSharpLanguageService(package : FSharpPackage) = inherit AbstractLanguageService(package) @@ -112,4 +98,4 @@ and [] | _ -> () | _ -> () - #endif \ No newline at end of file + #endif diff --git a/vsintegration/src/FSharp.LanguageService/FSharpProjectSite.fs b/vsintegration/src/FSharp.LanguageService/ProjectSite.fs similarity index 94% rename from vsintegration/src/FSharp.LanguageService/FSharpProjectSite.fs rename to vsintegration/src/FSharp.LanguageService/ProjectSite.fs index 12998099ff1..6f06a9525de 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharpProjectSite.fs +++ b/vsintegration/src/FSharp.LanguageService/ProjectSite.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. namespace Microsoft.VisualStudio.FSharp.LanguageService @@ -10,7 +10,6 @@ open Microsoft.VisualStudio.FSharp.LanguageService open Microsoft.FSharp.Compiler.SourceCodeServices open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Internal.Utilities.Collections -open Internal.Utilities.Debug open System open System.IO open System.Diagnostics @@ -80,4 +79,4 @@ type internal FSharpProjectSite(hierarchy: IVsHierarchy, serviceProvider: System for ref in this.GetCurrentMetadataReferences() do if not(references |> Seq.contains(ref.FilePath)) then this.RemoveReference(ref.FilePath) // If the order of files changed, that'll be captured in the checkOptions. - checkOptions <- Some(ProjectSitesAndFiles.GetProjectOptionsForProjectSite(site, site.ProjectFileName())) \ No newline at end of file + checkOptions <- Some(ProjectSitesAndFiles.GetProjectOptionsForProjectSite(site, site.ProjectFileName())) diff --git a/vsintegration/src/FSharp.LanguageService/Vs.fs b/vsintegration/src/FSharp.LanguageService/Vs.fs index 360f3229791..a79e42f008c 100644 --- a/vsintegration/src/FSharp.LanguageService/Vs.fs +++ b/vsintegration/src/FSharp.LanguageService/Vs.fs @@ -14,7 +14,6 @@ open Microsoft.VisualStudio.Text open Microsoft.VisualStudio.TextManager.Interop open Microsoft.VisualStudio.OLE.Interop open Microsoft.FSharp.Compiler.Range -open Internal.Utilities.Debug open System.Runtime.InteropServices /// Helper methods for interoperating with COM diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/AssemblyReferenceNode.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/AssemblyReferenceNode.cs index 274d3a72854..462cefbb878 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/AssemblyReferenceNode.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/AssemblyReferenceNode.cs @@ -13,7 +13,6 @@ using Microsoft.VisualStudio.Shell; using Microsoft.VisualStudio.Shell.Interop; using Microsoft.VisualStudio.OLE.Interop; -using MSBuild = Microsoft.Build.BuildEngine; using Microsoft.Build.Utilities; using System.Diagnostics.CodeAnalysis; using ShellConstants = Microsoft.VisualStudio.Shell.Interop.Constants; @@ -486,9 +485,6 @@ private void ResolveAssemblyReferenceByFullPath(string assemblyFullPath, AddRefe } Debug.Assert(isValidPath, string.Format("Expected assemblyFullPath to be a full path, but it was {0}", assemblyFullPath)); - // AddComPlusReferenceByFullPath - Action Trace = (s) => FSharpTrace.PrintLine("ProjectSystemReferenceResolution", () => "ResolveAssemblyReferenceByFullPath: " + s); - Trace("starting: \""+assemblyFullPath+"\""); this.msbuildProjectionInfo.WantHintPath = false; this.msbuildProjectionInfo.WantFusionName = false; this.msbuildProjectionInfo.WantSpecificVersion = null; @@ -503,18 +499,16 @@ private void ResolveAssemblyReferenceByFullPath(string assemblyFullPath, AddRefe } if (!this.resolvedInfo.WasSuccessfullyResolved) { - Trace("simple name resolution did not succeed"); this.msbuildProjectionInfo.WantHintPath = true; AddToProjectFileAndTryResolve(assemblyFullPath); } else { this.myAssemblyPath = assemblyFullPath; - Trace("simple name resolution succeeded"); // we successfully resolved it via simple name if (!this.resolvedInfo.IsPlatformAssembly) { - Trace("not a platform assembly"); + // not a platform assembly if (resolvedInfo.AssemblyName != null) { // Project file contains different reference than picked/shown in UI @@ -529,21 +523,21 @@ private void ResolveAssemblyReferenceByFullPath(string assemblyFullPath, AddRefe if (tab == AddReferenceDialogTab.DotNetTab) { - Trace("from .Net tab"); + // from .Net tab this.msbuildProjectionInfo.WantFusionName = true; this.msbuildProjectionInfo.WantSpecificVersion = true; } else { Debug.Assert(tab == AddReferenceDialogTab.BrowseTab); - Trace("not from .Net tab"); + // not from .Net tab this.msbuildProjectionInfo.WantHintPath = true; } } else { // platform assemblies can just resolve to simple name - Trace("it was a platform assembly"); + // it was a platform assembly } } // TODO - not accounting for case described below @@ -567,7 +561,7 @@ private void ResolveAssemblyReferenceByFullPath(string assemblyFullPath, AddRefe { this.ProjectMgr.AddReferenceCouldNotBeAddedErrorMessage(assemblyFullPath); } - Trace("finished: \"" + assemblyFullPath + "\""); + // "finished: assemblyFullPath } /// @@ -576,25 +570,19 @@ private void ResolveAssemblyReferenceByFullPath(string assemblyFullPath, AddRefe /// Either a full path to a file on disk, or a simple name or fusion name private void AddToProjectFileAndTryResolve(string assemblyInclude) { - Action Trace = (s) => FSharpTrace.PrintLine("ProjectSystemReferenceResolution", () => "ResolveAssemblyReferenceCore: " + s); - Trace("starting: \"" + assemblyInclude + "\""); + // starting: assemblyInclude ProjectInstance instance = null; instance = this.ProjectMgr.BuildProject.CreateProjectInstance(); // use a fresh instance... instance.AddItem(ProjectFileConstants.Reference, assemblyInclude); // ...and mutate it as through there were another there - Trace("instance[Configuration]=" + instance.GetPropertyValue("Configuration")); - Trace("instance[Platform]=" + instance.GetPropertyValue("Platform")); var result = BuildInstance(this.ProjectMgr, ref instance, MsBuildTarget.ResolveAssemblyReferences); this.ResolveFromBuiltProject(assemblyInclude, result); - Trace("finished without finding original item: \"" + assemblyInclude + "\""); } private void ResolveFromBuiltProject(string assemblyInclude, BuildResult buildResult) { - Action Trace = (s) => FSharpTrace.PrintLine("ProjectSystemReferenceResolution", () => "ResolveAssemblyReferenceCore: " + s); - Trace("starting: \"" + assemblyInclude + "\""); if (!buildResult.IsSuccessful) { - Trace("ResolveAssemblyReferences build failed."); + // ResolveAssemblyReferences build failed. return; } System.Collections.Generic.IEnumerable group = buildResult.ProjectInstance.GetItems(ProjectFileConstants.ReferencePath); @@ -622,12 +610,12 @@ private void ResolveFromBuiltProject(string assemblyInclude, BuildResult buildRe { this.myAssemblyPath = Path.Combine(this.ProjectMgr.ProjectFolder, this.myAssemblyPath); } - Trace("finished and found original item: \"" + assemblyInclude + "\""); + // finished and found original item return; } } } - Trace("finished without finding original item: \"" + assemblyInclude + "\""); + // finished without finding original item } /// diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ConfigProvider.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ConfigProvider.cs index 7f239e8ce9a..eb713f4e23b 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ConfigProvider.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ConfigProvider.cs @@ -9,7 +9,6 @@ using System.Globalization; using System.Collections; using System.IO; -using MSBuild = Microsoft.Build.BuildEngine; using System.Collections.Generic; using System.Linq; using EnvDTE; diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ConfigurationProperties.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ConfigurationProperties.cs index c2a2395d271..6cfb318c897 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ConfigurationProperties.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ConfigurationProperties.cs @@ -10,7 +10,6 @@ using System.Collections; using System.IO; using System.Linq; -using MSBuild = Microsoft.Build.BuildEngine; using System.Collections.Generic; using Microsoft.VisualStudio.FSharp.LanguageService; diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/FileNode.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/FileNode.cs index a9f6837ecee..761e092518f 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/FileNode.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/FileNode.cs @@ -18,7 +18,6 @@ using OleConstants = Microsoft.VisualStudio.OLE.Interop.Constants; using VsCommands = Microsoft.VisualStudio.VSConstants.VSStd97CmdID; using VsCommands2K = Microsoft.VisualStudio.VSConstants.VSStd2KCmdID; -using MSBuild = Microsoft.Build.BuildEngine; using System.Diagnostics.CodeAnalysis; namespace Microsoft.VisualStudio.FSharp.ProjectSystem diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/GroupingReferenceNode.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/GroupingReferenceNode.cs index 102d0386bcf..62435b8fb79 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/GroupingReferenceNode.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/GroupingReferenceNode.cs @@ -13,7 +13,6 @@ using Microsoft.VisualStudio.Shell; using Microsoft.VisualStudio.Shell.Interop; using Microsoft.VisualStudio.OLE.Interop; -using MSBuild = Microsoft.Build.BuildEngine; using Microsoft.Build.Utilities; using System.Diagnostics.CodeAnalysis; using ShellConstants = Microsoft.VisualStudio.Shell.Interop.Constants; diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/IVsSQM.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/IVsSQM.cs deleted file mode 100644 index 04d8e7fce4e..00000000000 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/IVsSQM.cs +++ /dev/null @@ -1,312 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. - -#pragma warning disable 3001 - -namespace Microsoft.VisualStudio.Shell.Interop -{ - using System; - using System.Runtime.InteropServices; - - [ComImport()] - [ComVisible(false)] - [Guid("C1F63D0C-4CAE-4907-BE74-EEB75D386ECB")] - [InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)] - public interface IVsSqm - { - void GetSessionStartTime( - [Out] out System.Runtime.InteropServices.ComTypes.FILETIME time - ); - void GetFlags( - [Out, MarshalAs(UnmanagedType.U4)] out System.UInt32 flags - ); - void SetFlags( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 flags - ); - void ClearFlags( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 flags - ); - void AddItemToStream( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void SetDatapoint( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - // OBSOLETE IN SQMAPI.DLL. DO NOT CALL. - void GetDatapoint ( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [Out, MarshalAs(UnmanagedType.U4)] out System.UInt32 value - ); - void EnterTaggedAssert( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dwTag, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dwPossibleBuild, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dwActualBuild - ); - void RecordCmdData( - [In] ref Guid pguidCmdGroup, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void GetHashOfGuid ( - [In] ref Guid hashGuid, - [Out, MarshalAs(UnmanagedType.U4)] out System.UInt32 resultantHash - ); - void GetHashOfString ( - [In, MarshalAs(UnmanagedType.BStr)] string hashString, - [Out, MarshalAs(UnmanagedType.U4)] out System.UInt32 resultantHash - ); - void IncrementDatapoint( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - - void SetDatapointBits( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - - void SetDatapointIfMax( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void SetDatapointIfMin( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void AddToDatapointAverage( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void StartDatapointTimer( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID - ); - void RecordDatapointTimer( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID - ); - void AccumulateDatapointTimer( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID - ); - void AddTimerToDatapointAverage( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID - ); - void AddArrayToStream( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.LPArray, ArraySubType = UnmanagedType.U4, SizeParamIndex = 2)] System.UInt32[] data, - [In, MarshalAs(UnmanagedType.I4)] int count - ); - } - - [ComImport()] - [ComVisible(false)] - [Guid("BE5F55EB-F02D-4217-BCB6-A290800AF6C4")] - [InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)] - public interface IVsSqm2 - { - void SetBoolDatapoint( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 fValue - ); - - void SetStringDatapoint( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.BStr)] string strValue - ); - - void AddToStreamDWord( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 cTuple, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - - void AddToStreamString( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 cTuple, - [In, MarshalAs(UnmanagedType.BStr)] string strValue - ); - - void GetObfuscatedString( - [In, MarshalAs(UnmanagedType.BStr)] string input, - [Out, MarshalAs(UnmanagedType.BStr)] out string output - ); - } - - [ComImport()] - [ComVisible(false)] - [Guid("B17A7D4A-C1A3-45A2-B916-826C3ABA067E")] - [InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)] - public interface IVsSqmMulti - { - [return: MarshalAs(UnmanagedType.VariantBool)] - bool GetOptInStatus(); - void UnloadSessions( - ); - void EndAllSessionsAndAbortUploads( - ); - void BeginSession( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionType, - [In, MarshalAs(UnmanagedType.VariantBool)] System.Boolean alwaysSend, - [Out, MarshalAs(UnmanagedType.U4)] out System.UInt32 sessionHandle - ); - void EndSession( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle - ); - void RegisterSessionHandle( - [In] ref Guid sessionIdentifier, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dwSessionHandle - ) ; - [return: MarshalAs(UnmanagedType.U4)] - int GetSessionHandleByIdentifier( - [In] ref Guid sessionIdentifier - ); - void GetSessionStartTime( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [Out] out System.Runtime.InteropServices.ComTypes.FILETIME time - ); - Guid GetGlobalSessionGuid(); - [return: MarshalAs(UnmanagedType.U4)] - int GetGlobalSessionHandle(); - void SetGlobalSessionGuid( - [In] ref Guid pguidSessionGuid - ); - void GetFlags( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [Out, MarshalAs(UnmanagedType.U4)] out System.UInt32 flags - ); - void SetFlags( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 flags - ); - void ClearFlags( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 flags - ); - void SetDatapoint( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void SetBoolDatapoint( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 fValue - ); - void SetStringDatapoint( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.BStr)] string strValue - ); - void SetDatapointBits( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void IncrementDatapoint( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - - void SetDatapointIfMax( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void SetDatapointIfMin( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void AddToDatapointAverage( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void StartDatapointTimer( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID - ); - void RecordDatapointTimer( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID - ); - void AccumulateDatapointTimer( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID - ); - void AddTimerToDatapointAverage( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID - ); - void AddItemToStream( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void AddArrayToStream( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.LPArray, ArraySubType = UnmanagedType.U4, SizeParamIndex = 2)] System.UInt32[] data, - [In, MarshalAs(UnmanagedType.I4)] int count - ); - void AddToStreamDWord( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 cTuple, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void AddToStreamString( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 cTuple, - [In, MarshalAs(UnmanagedType.BStr)] string strValue - ); - void RecordCmdData( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 sessionHandle, - [In] ref Guid pguidCmdGroup, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 dataPointID, - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 value - ); - void GetHashOfGuid ( - [In] ref Guid hashGuid, - [Out, MarshalAs(UnmanagedType.U4)] out System.UInt32 resultantHash - ); - void GetHashOfString ( - [In, MarshalAs(UnmanagedType.BStr)] string hashString, - [Out, MarshalAs(UnmanagedType.U4)] out System.UInt32 resultantHash - ); - void SetProperty( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 propid, - [In] ref Guid varKey, - [In] object varValue - ); - void Get64BitHashOfString ( - [In, MarshalAs(UnmanagedType.BStr)] string hashString, - [Out, MarshalAs(UnmanagedType.U8)] out System.UInt64 resultantHash - ); - } - - [ComImport()] - [ComVisible(false)] - [Guid("16be4288-950b-4265-b0dc-280b89ca9979")] - [InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)] - public interface IVsSqmOptinManager - { - void GetOptinStatus( - [Out, MarshalAs(UnmanagedType.U4)] out System.UInt32 optinStatus, - [Out, MarshalAs(UnmanagedType.U4)] out System.UInt32 preferences - ); - - void SetOptinStatus( - [In, MarshalAs(UnmanagedType.U4)] System.UInt32 optinStatus - ); - } - - [ComImport()] - [ComVisible(false)] - [Guid("2508FDF0-EF80-4366-878E-C9F024B8D981")] - public interface SVsLog - { - } - -} diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/Interfaces.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/Interfaces.cs index 9dc9d738c12..11e79a8bfd5 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/Interfaces.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/Interfaces.cs @@ -7,7 +7,6 @@ using OleConstants = Microsoft.VisualStudio.OLE.Interop.Constants; using VsCommands = Microsoft.VisualStudio.VSConstants.VSStd97CmdID; using VsCommands2K = Microsoft.VisualStudio.VSConstants.VSStd2KCmdID; -using MSBuild = Microsoft.Build.BuildEngine; using System.Diagnostics.CodeAnalysis; namespace Microsoft.VisualStudio.FSharp.ProjectSystem diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/LinkedFileNode.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/LinkedFileNode.cs index cacfe667299..0c2c54bfab3 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/LinkedFileNode.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/LinkedFileNode.cs @@ -17,7 +17,6 @@ using OleConstants = Microsoft.VisualStudio.OLE.Interop.Constants; using VsCommands = Microsoft.VisualStudio.VSConstants.VSStd97CmdID; using VsCommands2K = Microsoft.VisualStudio.VSConstants.VSStd2KCmdID; -using MSBuild = Microsoft.Build.BuildEngine; namespace Microsoft.VisualStudio.FSharp.ProjectSystem { diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/OutputGroup.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/OutputGroup.cs index 5fb282c22b3..64026b6164b 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/OutputGroup.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/OutputGroup.cs @@ -11,7 +11,6 @@ using Microsoft.VisualStudio.OLE.Interop; using Microsoft.VisualStudio.Shell; -using MSBuild = Microsoft.Build.BuildEngine; using System.Diagnostics.CodeAnalysis; namespace Microsoft.VisualStudio.FSharp.ProjectSystem diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectConfig.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectConfig.cs index 04ff876e1d9..1244c515964 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectConfig.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectConfig.cs @@ -10,7 +10,6 @@ using System.Security; using System.IO; using System.Collections.Generic; -using MSBuild = Microsoft.Build.BuildEngine; using System.Diagnostics.CodeAnalysis; using System.Linq; using Microsoft.VisualStudio.FSharp.LanguageService; diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectDesignerDocumentManager.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectDesignerDocumentManager.cs index b64056cec30..07e4b08ad9f 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectDesignerDocumentManager.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectDesignerDocumentManager.cs @@ -16,7 +16,6 @@ using Microsoft.VisualStudio.Shell.Interop; using Microsoft.VisualStudio.Shell; using System.Net; -using MSBuild = Microsoft.Build.BuildEngine; using IOleServiceProvider = Microsoft.VisualStudio.OLE.Interop.IServiceProvider; using IServiceProvider = System.IServiceProvider; diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectElement.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectElement.cs index 67efa9c8cf5..662feff90ff 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectElement.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectElement.cs @@ -6,7 +6,7 @@ using System.Globalization; using System.IO; using System.Runtime.InteropServices; -using MSBuild = Microsoft.Build.BuildEngine; +using Microsoft.Build.Evaluation; namespace Microsoft.VisualStudio.FSharp.ProjectSystem { @@ -135,7 +135,7 @@ public ProjectElement(ProjectNode project, string itemPath, string itemType) private void DoAdd(string itemType, string itemPath) { - var added = this.itemProject.BuildProject.AddItem(itemType, Microsoft.Build.BuildEngine.Utilities.Escape(itemPath)); + var added = this.itemProject.BuildProject.AddItem(itemType, ProjectCollection.Escape(itemPath)); Debug.Assert(added.Count == 1, "adding a file created more than 1 new item, should not be possible since we escape wildcard characters"); this.item = added[0]; @@ -328,7 +328,7 @@ public string GetMetadataAndThrow(string attributeName, Exception exception) public void Rename(string newPath) { - string escapedPath = Microsoft.Build.BuildEngine.Utilities.Escape(newPath); + string escapedPath = ProjectCollection.Escape(newPath); if (this.IsVirtual) { virtualProperties[ProjectFileConstants.Include] = escapedPath; diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectFactory.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectFactory.cs index ba7f8633ef3..3f234434209 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectFactory.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectFactory.cs @@ -4,7 +4,6 @@ using System.Collections.Generic; using System.Diagnostics; using System.IO; -using MSBuild = Microsoft.Build.BuildEngine; using Microsoft.VisualStudio.OLE.Interop; using Microsoft.VisualStudio.Shell.Interop; using Microsoft.VisualStudio.Shell; @@ -184,7 +183,7 @@ public ProjectInspector(string filename) { xmlProj = Microsoft.Build.Construction.ProjectRootElement.Open(filename); } - catch (Microsoft.Build.BuildEngine.InvalidProjectFileException) + catch (Microsoft.Build.Exceptions.InvalidProjectFileException) { // leave xmlProj non-initialized, other methods will check its state in prologue } diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectNode.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectNode.cs index ed5588d7eca..722356327da 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectNode.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectNode.cs @@ -21,7 +21,6 @@ using Microsoft.VisualStudio.Shell.Interop; using Microsoft.VisualStudio.Shell; using System.Net; -using MSBuild = Microsoft.Build.BuildEngine; using IOleServiceProvider = Microsoft.VisualStudio.OLE.Interop.IServiceProvider; using IServiceProvider = System.IServiceProvider; using OleConstants = Microsoft.VisualStudio.OLE.Interop.Constants; @@ -41,17 +40,6 @@ namespace Microsoft.VisualStudio.FSharp.ProjectSystem { - internal class FSharpTrace - { - static public void PrintLine(string traceClass, Func msg) - { - if (global::Internal.Utilities.Debug.Trace.ShouldLog(traceClass)) - { - var fsFunc = Microsoft.FSharp.Core.FuncConvert.ToFSharpFunc(new Converter((u) => msg())); - global::Internal.Utilities.Debug.Trace.PrintLine(traceClass, fsFunc); - } - } - } internal delegate void MSBuildCoda(MSBuildResult result, ProjectInstance instance); @@ -3423,15 +3411,6 @@ internal virtual BuildSubmission DoMSBuildSubmission(BuildKind buildKind, string // F#-specific properties projectInstance.SetProperty(GlobalProperty.VisualStudioStyleErrors.ToString(), "true"); - // Get SQM GlobalSessionGuid from Visual Studio to pass FSC.exe, - // so multiple SQM sessions can be correlated later when analying SQM data. - IVsSqmMulti sqm = this.GetService(typeof(Microsoft.VisualStudio.Shell.Interop.SVsLog)) as IVsSqmMulti; - if (sqm != null) - { - var sessionGuid = sqm.GetGlobalSessionGuid(); - projectInstance.SetProperty(GlobalProperty.SqmSessionGuid.ToString(), sessionGuid.ToString()); - } - if (extraProperties != null) { foreach (var prop in extraProperties) diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectReferenceNode.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectReferenceNode.cs index db036ba8fbb..a2b1136dc4b 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectReferenceNode.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectReferenceNode.cs @@ -14,7 +14,6 @@ using Microsoft.VisualStudio.Shell; using Microsoft.VisualStudio.Shell.Interop; using Microsoft.VisualStudio.OLE.Interop; -using MSBuild = Microsoft.Build.BuildEngine; using Microsoft.Build.Utilities; using VSConstants = Microsoft.VisualStudio.VSConstants; using Task = Microsoft.VisualStudio.Shell.Task; diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectSystem.Base.csproj b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectSystem.Base.csproj index 6222478a047..a8653ea04db 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectSystem.Base.csproj +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectSystem.Base.csproj @@ -30,8 +30,6 @@ $(DefineConstants);QUERIES_IN_FSLIB $(DefineConstants);PUT_TYPE_PROVIDERS_IN_FSCORE; $(DefineConstants);FX_ATLEAST_LINQ - - $(DefineConstants);FX_PREFERRED_UI_LANG $(MSBuildExtensionsPath)\Microsoft\VisualStudio\v$(VisualStudioVersion)\VSSDK @@ -59,12 +57,21 @@ true - - - - - - + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Utilities.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Tasks.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Conversion.Core.dll + @@ -83,7 +90,6 @@ - @@ -92,14 +98,17 @@ - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.14.2.25123\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Shell.Design.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll + @@ -113,6 +122,7 @@ + @@ -125,6 +135,7 @@ + @@ -142,7 +153,7 @@ - + @@ -152,7 +163,6 @@ - @@ -215,10 +225,6 @@ {DED3BBD7-53F4-428A-8C9F-27968E768605} FSharp.Core - - {ee85aab7-cda0-4c4e-bda0-a64ccc413e3f} - FSharp.LanguageService - @@ -235,4 +241,4 @@ - \ No newline at end of file + diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ReferenceContainerNode.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ReferenceContainerNode.cs index a210ddcc6f0..5c8c1ca8ea1 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ReferenceContainerNode.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ReferenceContainerNode.cs @@ -17,7 +17,6 @@ using OleConstants = Microsoft.VisualStudio.OLE.Interop.Constants; using VsCommands = Microsoft.VisualStudio.VSConstants.VSStd97CmdID; using VsCommands2K = Microsoft.VisualStudio.VSConstants.VSStd2KCmdID; -using MSBuild = Microsoft.Build.BuildEngine; namespace Microsoft.VisualStudio.FSharp.ProjectSystem diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/Utilities.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/Utilities.cs index 61d3307b9cb..95575e46522 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/Utilities.cs +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/Utilities.cs @@ -15,7 +15,6 @@ using System.Text.RegularExpressions; using System.Net; using System.Reflection; -using MSBuild = Microsoft.Build.BuildEngine; using Microsoft.VisualStudio.TextManager.Interop; using Microsoft.VisualStudio.OLE.Interop; using Microsoft.VisualStudio.Shell.Interop; diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/AppConfigHelper.fs b/vsintegration/src/FSharp.ProjectSystem.FSharp/AppConfigHelper.fs index 6067a8d8505..f5bbc8294a2 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/AppConfigHelper.fs +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/AppConfigHelper.fs @@ -22,13 +22,11 @@ namespace Microsoft.VisualStudio.FSharp.ProjectSystem open System.Globalization open System.Text - open Microsoft.Build.BuildEngine open Microsoft.Win32 open Microsoft.VisualStudio open Microsoft.VisualStudio.Shell open Microsoft.VisualStudio.Shell.Interop - open Microsoft.VisualStudio.Shell.Flavor open Microsoft.VisualStudio.OLE.Interop open Microsoft.VisualStudio.FSharp.ProjectSystem open Microsoft.VisualStudio.FSharp.LanguageService diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs index 7af5072379c..e6f92402dc1 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs @@ -40,9 +40,6 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem open EnvDTE - open Microsoft.Build.BuildEngine - open Internal.Utilities.Debug - module internal VSHiveUtilities = /// For a given sub-hive, check to see if a 3rd party has specified any /// custom/extended property pages. @@ -390,13 +387,8 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem // for example. If necessary, this can be changed - but please just try to avoid doing a gratuitous rename. let mutable sourcesAndFlags : option<(array * array)> = None #if DEBUG - let mutable shouldLog = false // can poke this in the debugger to turn on logging - let logger = new Microsoft.Build.BuildEngine.ConsoleLogger(Microsoft.Build.Framework.LoggerVerbosity.Diagnostic, - (fun s -> - let self = this - ignore self // ensure debugger has local in scope, so can poke self.shouldLog - if shouldLog then - Trace.Print("MSBuild", fun _ -> "MSBuild: " + s)), + let logger = new Microsoft.Build.Logging.ConsoleLogger(Microsoft.Build.Framework.LoggerVerbosity.Diagnostic, + (fun s -> Trace.WriteLine("MSBuild: " + s)), (fun _ -> ()), (fun _ -> ()) ) #endif @@ -442,12 +434,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem this.AddCATIDMapping(typeof, typeof.GUID) #if DEBUG - if Trace.ShouldLog("MSBuild") then - - this.SetDebugLogger(logger) - Trace.PrintLine("ProjectSystem", fun _ -> "attached MSBuild logger") - else - Trace.PrintLine("ProjectSystem", fun _ -> "not choosing to attach MSBuild logger") + this.SetDebugLogger(logger) #endif member private this.GetCurrentFrameworkName() = let tfm = this.GetTargetFrameworkMoniker() @@ -578,9 +565,10 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem | Some(libraryManager) -> libraryManager.UnregisterHierarchy(this.InteropSafeIVsHierarchy) | _ -> () + + closeNotifier.Notify() vsProject <- null accessor <- null - closeNotifier.Notify() base.Close() override x.Load(filename:string, location:string, name:string, flags:uint32, iidProject:byref, canceled:byref ) = @@ -1322,9 +1310,6 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem override x.InvokeMsBuild(target, extraProperties) = let result = base.InvokeMsBuild(target, extraProperties) -#if DEBUG - Trace.PrintLine("ProjectSystem", fun _ -> sprintf "Called InvokeMsBuild(%s), result: %A" target result) -#endif result // Fulfill HostObject contract with Fsc task, and enable 'capture' of compiler flags for the project. @@ -1341,10 +1326,6 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem let normalizedSources = sources |> Array.map (fun fn -> System.IO.Path.GetFullPath(System.IO.Path.Combine(x.ProjectFolder, fn))) let r = (normalizedSources, flags) sourcesAndFlags <- Some(r) -#if DEBUG - Trace.PrintLine("ProjectSystem", fun _ -> sprintf "FSharpProjectNode(%s) sourcesAndFlags: %A" x.ProjectFile sourcesAndFlags) - Trace.PrintLine("ProjectSystem", fun _ -> sprintf "Compile() was called on FSharpProjectNode(%s); will we actually build? %A" x.ProjectFile actuallyBuild) -#endif if projectSite.State = ProjectSiteOptionLifetimeState.Opening then // This is the first time, so set up interface for language service to talk to us projectSite.Open(x.CreateRunningProjectSite()) @@ -1376,9 +1357,6 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem if not(inMidstOfReloading) && not(VsBuildManagerAccessorExtensionMethods.IsInProgress(accessor)) then #else if not(inMidstOfReloading) && not(FSharpBuildStatus.IsInProgress) then -#endif -#if DEBUG - use t = Trace.Call("ProjectSystem", "FSharpProjectNode::ComputeSourcesAndFlags()", fun _ -> x.ProjectFile) #endif // REVIEW CompilerFlags will be stale since last 'save' of MSBuild .fsproj file - can we do better? try @@ -1403,20 +1381,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem // If property is not set - msbuild will resolve only primary dependencies, // and compiler will be very unhappy when during processing of referenced assembly it will discover that all fundamental types should be // taken from System.Runtime that is not supplied - let success = x.InvokeMsBuild("Compile", isBeingCalledByComputeSourcesAndFlags = true, extraProperties = [KeyValuePair("_ResolveReferenceDependencies", "true")]) -#if DEBUG - Trace.PrintLine("ProjectSystem", fun _ -> sprintf "InvokeMsBuild('Compile') success: %A" success.IsSuccessful) - if not compileWasActuallyCalled then - Trace.PrintLine("ProjectSystem", fun _ -> "BUG? In ComputeSourcesAndFlags(), but Compile() was not called") -#if DEBUG_BUT_CANT_TURN_ON_BECAUSE_FAILS_ON_NEW_PROJECT - Debug.Assert(false, "Please report: This assert means that we invoked MSBuild but Compile was not called. Unless you have a weird project file that would fail to build from the command-line with 'msbuild foo.fsproj', this should never happen.") -#endif - else - Trace.PrintLine("ProjectSystem", fun _ -> "In ComputeSourcesAndFlags(), Compile() was called, hurrah") - -#else - ignore(success) -#endif + let _ = x.InvokeMsBuild("Compile", isBeingCalledByComputeSourcesAndFlags = true, extraProperties = [KeyValuePair("_ResolveReferenceDependencies", "true")]) sourcesAndFlagsNotifier.Notify() finally actuallyBuild <- true @@ -1470,9 +1435,6 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem x.DoFixupAppConfigOnTargetFXChange(runtime, sku, targetFSharpCoreVersion, autoGenerateBindingRedirects) override x.SetHostObject(targetName, taskName, hostObject) = -#if DEBUG - Trace.PrintLine("ProjectSystem", fun _ -> sprintf "about to set HostObject to %s" x.ProjectFile) -#endif base.SetHostObject(targetName, taskName, hostObject) override x.SetBuildProject newProj = @@ -1565,9 +1527,6 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem // which will finally populate sourcesAndFlags with good values. // This means that ones the user fixes the problem, proper intellisense etc. should start immediately lighting up. sourcesAndFlags <- Some([||],[||]) -#if DEBUG - Trace.PrintLine("ProjectSystem", fun _ -> "First call to ComputeSourcesAndFlags failed") -#endif projectSite.Open(x.CreateRunningProjectSite()) () | _ -> () @@ -2297,14 +2256,14 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem match (cmd |> int32 |> enum) with //| VsCommands.Delete // REVIEW needs work to implement: see e.g. RemoveFromProjectFile() RemoveItem() CanRemoveItems() CanDeleteItem() DeleteFromStorage() - | VsCommands.ViewCode when guidCmdGroup = VsMenus.guidStandardCommandSet97 -> + | VSConstants.VSStd97CmdID.ViewCode when guidCmdGroup = VsMenus.guidStandardCommandSet97 -> result <- result ||| QueryStatusResult.SUPPORTED if noBuildInProgress then result <- result ||| QueryStatusResult.ENABLED VSConstants.S_OK - | VsCommands.ViewForm when guidCmdGroup = VsMenus.guidStandardCommandSet97 -> + | VSConstants.VSStd97CmdID.ViewForm when guidCmdGroup = VsMenus.guidStandardCommandSet97 -> if (x.IsFormSubType) then result <- result ||| QueryStatusResult.SUPPORTED if noBuildInProgress then diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectPrelude.fs b/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectPrelude.fs index d4e535d44b5..581f5b3e7bd 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectPrelude.fs +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectPrelude.fs @@ -39,7 +39,6 @@ namespace Microsoft.VisualStudio.FSharp.ProjectSystem open Microsoft.VisualStudio.Shell open Microsoft.VisualStudio.Shell.Interop - open Microsoft.VisualStudio.Shell.Flavor open Microsoft.VisualStudio.OLE.Interop open Microsoft.VisualStudio.FSharp.ProjectSystem.Automation open Microsoft.VisualStudio @@ -48,10 +47,6 @@ namespace Microsoft.VisualStudio.FSharp.ProjectSystem open System type IOleServiceProvider = Microsoft.VisualStudio.OLE.Interop.IServiceProvider - type ErrorHandler = Microsoft.VisualStudio.ErrorHandler - type VSConstants = Microsoft.VisualStudio.VSConstants - type VsCommands = Microsoft.VisualStudio.VSConstants.VSStd97CmdID - type VsCommands2K = Microsoft.VisualStudio.VSConstants.VSStd2KCmdID module internal FSharpSDKHelper = [] diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj b/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj index aa4295f02e2..61c8af317fa 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj @@ -6,10 +6,9 @@ FSharp true $(MSBuildExtensionsPath)\Microsoft\VisualStudio\v$(VisualStudioVersion)\VSSDK - 14.0 - v4.6 11 + Debug AnyCPU @@ -24,7 +23,6 @@ $(OtherFlags) --warnon:1182 --subsystemversion:6.00 FX_ATLEAST_45 false - true ProjectResources.rc true false @@ -33,7 +31,6 @@ true true - $(FSharpSourcesRoot)\..\loc\lcl\{Lang}\$(AssemblyName).dll.lcl @@ -55,9 +52,9 @@ true - + fsiCommands.vsct - + @@ -72,9 +69,6 @@ - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll - @@ -82,26 +76,24 @@ - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.14.2.25123\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - - - - - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Immutable.14.0.14.2.25123\lib\net45\Microsoft.VisualStudio.Shell.Immutable.14.0.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Utilities.Core.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.14.2.25123\lib\net45\Microsoft.VisualStudio.Utilities.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Tasks.Core.dll + @@ -115,6 +107,21 @@ + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Utilities.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Shell.Design.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Microsoft.VisualStudio.Shell.UI.Internal.14.0.25420\lib\net45\Microsoft.VisualStudio.Shell.UI.Internal.dll + {a437a6ec-5323-47c2-8f86-e2cac54ff152} FSharp.LanguageService.Compiler @@ -149,8 +156,8 @@ FSharp.Core - + true VSCTCompile;CopyCtoFile;$(BuildDependsOn) diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/FSharp.PropertiesPages.vbproj b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/FSharp.PropertiesPages.vbproj index f371720448b..5618881e01c 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/FSharp.PropertiesPages.vbproj +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/FSharp.PropertiesPages.vbproj @@ -75,21 +75,23 @@ - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.14.2.25123\lib\net45\Microsoft.VisualStudio.Shell.Design.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.14.2.25123\lib\net45\Microsoft.VisualStudio.Utilities.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll - + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Utilities.dll + - diff --git a/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj b/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj index 2f5033b930f..9df3c1f52fb 100644 --- a/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj +++ b/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj @@ -63,21 +63,11 @@ True - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Package.LanguageService.14.0.14.2.25123\lib\Microsoft.VisualStudio.Package.LanguageService.14.0.dll - - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.14.2.25123\lib\net45\Microsoft.VisualStudio.Utilities.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll - @@ -85,34 +75,51 @@ - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.14.2.25123\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Logic.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.Logic.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Editor.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Editor.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.UI.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.Wpf.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.UI.Wpf.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Data.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Logic.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Logic.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.CoreUtility.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Utilities.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Utilities.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.UI.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.Wpf.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.UI.Wpf.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.14.2.25123\lib\net45\Microsoft.VisualStudio.CoreUtility.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Package.LanguageService.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Package.LanguageService.$(RoslynVSBinariesVersion).dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.Data.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Language.StandardClassification.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Language.StandardClassification.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Editor.14.2.25123\lib\net45\Microsoft.VisualStudio.Editor.dll + + $(FSharpSourcesRoot)\..\packages\Roslyn.Microsoft.VisualStudio.ComponentModelHost.0.0.2\lib\net46\Microsoft.VisualStudio.ComponentModelHost.dll - diff --git a/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs b/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs index c8d84873989..ec8e95b5ff6 100644 --- a/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs +++ b/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. namespace Salsa @@ -220,4 +220,4 @@ type internal FSharpLanguageServiceTestable() as this = // // This is for unit testing only member this.WaitForBackgroundCompile() = - this.FSharpChecker.WaitForBackgroundCompile() \ No newline at end of file + this.FSharpChecker.WaitForBackgroundCompile() diff --git a/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj b/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj index b6764aec546..29f472185f7 100644 --- a/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj +++ b/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj @@ -6,7 +6,6 @@ FSharp true VisualFSharp.Salsa - v4.6 @@ -39,45 +38,57 @@ - - - - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.Wpf.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.UI.Wpf.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Utilities.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Tasks.Core.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.14.2.25123\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - - $(VS150COMNTOOLS)\..\IDE\PrivateAssemblies\Microsoft.VisualStudio.CommonIDE.dll - - - $(VS150COMNTOOLS)\..\IDE\PrivateAssemblies\Microsoft.VisualStudio.Text.Internal.dll - + + + $(FSharpSourcesRoot)\..\packages\RoslynDependencies.Microsoft.VisualStudio.Text.Internal.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Internal.dll + + + $(FSharpSourcesRoot)\..\packages\RoslynDependencies.Microsoft.VisualStudio.Platform.VSEditor.$(RoslynVSPackagesVersion)\lib\net46\Microsoft.VisualStudio.Platform.VSEditor.dll + + - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.Data.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.Wpf.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.UI.Wpf.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Data.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.CoreUtility.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Shell.Design.dll - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.14.2.25123\lib\net45\Microsoft.VisualStudio.CoreUtility.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll True diff --git a/vsintegration/tests/Salsa/VsMocks.fs b/vsintegration/tests/Salsa/VsMocks.fs index f8142f22fb1..c2b953ca33d 100644 --- a/vsintegration/tests/Salsa/VsMocks.fs +++ b/vsintegration/tests/Salsa/VsMocks.fs @@ -14,7 +14,6 @@ open Microsoft.VisualStudio.Shell open Microsoft.VisualStudio.Shell.Interop open Microsoft.VisualStudio.TextManager.Interop open Microsoft.VisualStudio.OLE.Interop -open Microsoft.Build.BuildEngine open System.Diagnostics open Microsoft.Build.Execution open Microsoft.Build.Framework diff --git a/vsintegration/tests/Salsa/salsa.fs b/vsintegration/tests/Salsa/salsa.fs index efec8b69310..d57f7aaa71c 100644 --- a/vsintegration/tests/Salsa/salsa.fs +++ b/vsintegration/tests/Salsa/salsa.fs @@ -18,7 +18,6 @@ open System.Text open System.Collections.Generic open System.Runtime.InteropServices open System.Threading -open Internal.Utilities.Debug open Microsoft.VisualStudio open Microsoft.VisualStudio.Shell.Interop open Microsoft.VisualStudio.FSharp.ProjectSystem @@ -49,8 +48,6 @@ module internal Salsa = #else member th.Compile(compile:System.Converter, flags:string[], sources:string[]) = #endif - use t = Trace.Call("MSBuild", "Compile", fun _ -> "Host compile invoke by Fsc task") - Trace.PrintLine("MSBuild", fun _ -> sprintf "flags=%A" flags) capturedFlags <- flags capturedSources <- sources if actuallyBuild then @@ -79,20 +76,9 @@ module internal Salsa = let engine = Utilities.InitializeMsBuildEngine(null) if not hasAttachedLogger then hasAttachedLogger<-true - let logRegular = Trace.ShouldLog("MSBuild") - let logPerf = Trace.ShouldLog("MSBuildPerf") - if logRegular || logPerf then - let l = if logRegular then - Trace.PrintLine("MSBuild", fun () -> "Detailed logging.") - new Microsoft.Build.BuildEngine.ConsoleLogger(LoggerVerbosity.Detailed) - else - Trace.PrintLine("MSBuild", fun () -> "Quiet logging.") - new Microsoft.Build.BuildEngine.ConsoleLogger(LoggerVerbosity.Quiet) - Trace.PrintLine("MSBuild", fun () -> "About to attach MSBuild console logger.") - // For Dev10 build we pass the logger to the Build call on the project object. - theAttachedLogger <- l - Trace.PrintLine("MSBuild", fun () -> "Attached MSBuild console logger.") - if logPerf then l.ApplyParameter("PERFORMANCESUMMARY", null) + let l = new Microsoft.Build.Logging.ConsoleLogger(LoggerVerbosity.Detailed) + // For Dev10 build we pass the logger to the Build call on the project object. + theAttachedLogger <- l engine /// Set a global property on the given project. @@ -113,7 +99,6 @@ module internal Salsa = | _ -> failwith "multiple projects found" match project with | null -> - use t = Trace.Call("MSBuildPerf","Creating new project", fun _-> projectFileName) let project = GlobalEngine().LoadProject(projectFileName) // Set global properties. SetGlobalProperty(project,"BuildingInsideVisualStudio", "true") @@ -126,7 +111,6 @@ module internal Salsa = hostObjectCachePerFilename.[projectFileName] <- theHostObject project, true, theHostObject | project-> - use t = Trace.Call("MSBuildPerf","Using existing project", fun _-> projectFileName) match hostObjectCachePerFilename.TryGetValue(projectFileName) with | true, theHostObject -> project, false, theHostObject @@ -148,10 +132,7 @@ module internal Salsa = if p = null then "" else p let items (project:Project) name = - let l = project.GetItems(name) |> Seq.map (fun i -> i.EvaluatedInclude) |> Seq.toList - //use t = Trace.Call("MSBuild","items", fun _ -> sprintf " %s: %A" name l) - l - + project.GetItems(name) |> Seq.map (fun i -> i.EvaluatedInclude) |> Seq.toList let oneItem (project:Project) name = match (items project name) with @@ -166,8 +147,7 @@ module internal Salsa = true /// Build the given target on the given project. Return the name of the main output assembly. - let Build(projectFileName, target, configuration, platform) : BuildResult = - use t = Trace.Call("MSBuild","build", fun _-> sprintf " target=%s project=%s configruation=%s platform=%s" target projectFileName configuration platform) + let Build(projectFileName, target:string, configuration, platform) : BuildResult = let project,_,_ = GetProject(projectFileName, configuration, platform) let projectInstance = project.CreateProjectInstance() let buildResult = projectInstance.Build(target, Seq.append project.ProjectCollection.Loggers (if theAttachedLogger=null then [] else [theAttachedLogger])) @@ -182,7 +162,6 @@ module internal Salsa = /// Return the name of the main output assembly but don't build let GetMainOutputAssembly(projectFileName, configuration, platform) : string = - use t = Trace.Call("MSBuild","GetMainOutputAssembly", fun _-> sprintf " project=%s configruation=%s platform=%s" projectFileName configuration platform) let project,_,_ = GetProject(projectFileName, configuration, platform) let baseName = Path.GetFileNameWithoutExtension(projectFileName)+".exe" let projectInstance = project.CreateProjectInstance() @@ -193,7 +172,6 @@ module internal Salsa = let CreateFSharpManifestResourceName(projectFileName,configuration, platform) : (string * string) list= let targetName = "CreateManifestResourceNames" - use t = Trace.Call("MSBuild", targetName, fun _-> sprintf " target=%s project=%s configruation=%s platform=%s" targetName projectFileName configuration platform) let project,_,_ = GetProject(projectFileName, configuration, platform) SetGlobalProperty(project, "CreateManifestResourceNamesDependsOn", "SplitResourcesByCulture") let projectInstance = project.CreateProjectInstance() @@ -216,15 +194,10 @@ module internal Salsa = /// Compute the Flags and Sources let GetFlagsAndSources(project:Project, host:HostCompile) : BuildFlags = let result = - use t = Trace.Call("MSBuildPerf","Calling compile to get flags", fun _-> "") use xx = host.CaptureSourcesAndFlagsWithoutBuildingForABit() project.IsBuildEnabled <- true - let loggers = - if Trace.ShouldLog("MSBuild") then - seq { yield (new Microsoft.Build.BuildEngine.ConsoleLogger(LoggerVerbosity.Detailed) :> ILogger) } - else - [] :> seq + let loggers = seq { yield (new Microsoft.Build.Logging.ConsoleLogger(LoggerVerbosity.Detailed) :> ILogger) } let r = project.Build("Compile", loggers) if not(r) then @@ -243,16 +216,12 @@ module internal Salsa = sources = result.sources |> List.map Canonicalize } let CrackProject(projectFileName, configuration, platform) = - use t = Trace.Call("MSBuild","crackProject", fun _-> sprintf " project=%s" projectFileName) let project,created,host = GetProject(projectFileName, configuration, platform) - Trace.PrintLine("MSBuild", fun _ -> sprintf "Project text:\n %s " (File.ReadAllText(projectFileName))) try try - let result = GetFlagsAndSources(project,host) - Trace.PrintLine("MSBuild", fun _ -> sprintf "Resolved flags and sources:\n %A \n %A" result.flags result.sources) - result + GetFlagsAndSources(project,host) with e -> System.Diagnostics.Debug.Assert(false, sprintf "Bug seen in MSBuild CrackProject: %s %s %s\n" (e.GetType().Name) e.Message (e.StackTrace)) reraise() @@ -285,7 +254,6 @@ module internal Salsa = || flags = None || prevConfig <> curConfig || prevPlatform <> curPlatform then - Trace.PrintLine("ProjectSite", fun _ -> sprintf "Timestamp of %s changed. New timestamp=%A, old timestamp=%A" projectfile newtimestamp timestamp) timestamp <- newtimestamp prevConfig <- curConfig prevPlatform <- curPlatform @@ -312,7 +280,6 @@ module internal Salsa = member this.CompilerFlags() = let flags = GetFlags() let result = flags.flags - Trace.PrintLine("ProjectSite", fun _ -> sprintf "MSBuild flags were %A." result) result |> List.toArray member this.ProjectFileName() = projectfile @@ -661,7 +628,6 @@ module internal Salsa = let sb = new System.Text.StringBuilder() let Append (text:string) = - Trace.PrintLine("VisualFSharp.Salsa", fun _ -> text) sb.Append(text+"\r\n") |> ignore Append "" Append " " @@ -728,7 +694,6 @@ module internal Salsa = Append (sprintf " " targetsFileFolder) Append "" - Trace.PrintLine("VisualFSharp.Salsa", fun _ -> sprintf "Project text:\n%s" (sb.ToString()) ) sb.ToString() @@ -745,11 +710,9 @@ module internal Salsa = let Plat() = let _,p = ConfPlat() in p interface ProjectBehaviorHooks with member x.CreateProjectHook (projectName, files, references, projectReferences, disabledWarnings, defines, versionFile, otherFlags, preImportXml, targetFrameworkVersion : string) = - use t = Trace.Call("VisualFSharp.Salsa", "CreateMsBuildProject", fun _ -> sprintf " projectName=%s" projectName) if File.Exists(projectName) then File.Delete(projectName) let text = CreateMsBuildProjectText useInstalledTargets (files, references, projectReferences, disabledWarnings, defines, versionFile, otherFlags, preImportXml, targetFrameworkVersion) - Trace.PrintLine("VisualFSharp.Salsa", fun _ -> text) File.AppendAllText(projectName,text+"\r\n") member x.InitializeProjectHook op = openProject <- Some(op:?>IOpenProject) @@ -836,7 +799,6 @@ module internal Salsa = member vs.IsShiftKeyDown = shiftKeyDown member vs.PushUndo(u) = - Trace.PrintLine("SalsaUndo", fun _ -> sprintf "Pushing cleanup action %A" u) undoStack<-u::undoStack member vs.GetColorizer(view:IVsTextView) = let _,buffer = view.GetBuffer() @@ -887,7 +849,7 @@ module internal Salsa = vs.LanguageService.OnIdle() match focusFile with | Some(focusFile) -> focusFile.OnIdle() - | None -> Trace.PrintLine("ChangeEvents", fun _ -> "In TakeCoffeeBreak there was no focus file to idle.") + | None -> () member vs.ShiftKeyDown() = shiftKeyDown <- true member vs.ShiftKeyUp() = shiftKeyDown <- false member vs.TakeCoffeeBreak() = @@ -912,14 +874,12 @@ module internal Salsa = undoActions |> List.iter(function DeleteFile f -> - Trace.PrintLine("SalsaUndo", fun _ -> sprintf "Performing undo action: DeleteFile %s" f) try File.Delete(f) with e-> printf "Failed to Delete file '%s'" f raise e | RemoveFolder f -> - Trace.PrintLine("SalsaUndo", fun _ -> sprintf "Performing undo action: RemoveFolder %s" f) try if Directory.Exists(f) then Directory.Delete(f,true) with diff --git a/vsintegration/tests/unittests/TestLib.LanguageService.fs b/vsintegration/tests/unittests/TestLib.LanguageService.fs index e6dc71eb8e5..efdc1e5543e 100644 --- a/vsintegration/tests/unittests/TestLib.LanguageService.fs +++ b/vsintegration/tests/unittests/TestLib.LanguageService.fs @@ -12,7 +12,6 @@ open Salsa.VsMocks open UnitTests.TestLib.Salsa open UnitTests.TestLib.Utils open Microsoft.FSharp.Compiler -open Internal.Utilities.Debug open System.Text.RegularExpressions open Microsoft.FSharp.Compiler.SourceCodeServices #nowarn "52" // The value has been copied to ensure the original is not mutated @@ -376,7 +375,6 @@ type LanguageServiceBaseTests() = // Under .NET 4.0 we don't allow 3.5.0.0 assemblies let AssertNotBackVersionAssembly(args:AssemblyLoadEventArgs) = - Trace.PrintLine("AssembliesLoadedByUnittests",fun _ -> sprintf "ASSEMBLY LOAD: %A" (args.LoadedAssembly)) // We're worried about loading these when running against .NET 4.0: // Microsoft.Build.Tasks.v3.5, Version=3.5.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a @@ -429,11 +427,7 @@ type LanguageServiceBaseTests() = ShiftKeyUp(currentVS) ops.CleanInvisibleProject(currentVS) -// do setDiagnosticsChannel(Some(Console.Out)); do AbstractIL.Diagnostics.setDiagnosticsChannel(None); - // To disable a logging class, put an underscore _after_ its name. - //Trace.Log <- "ChangeEvents_;SyncOp_;Reactor_;ProjectSite_;IncrementalBuild_;Build_;Salsa_;SalsaUndo_;MSBuild_;MSBuildPerf_;IncrementalBuildWorkUnits_;LanguageService_;StripSystemImportsFromTcConfig_;ProjectSystem_" -// Trace.Log <- "*" ResetStopWatch() testStopwatch.Reset() testStopwatch.Start() diff --git a/vsintegration/tests/unittests/TestLib.ProjectSystem.fs b/vsintegration/tests/unittests/TestLib.ProjectSystem.fs index b37120877e6..fdc63df5b56 100644 --- a/vsintegration/tests/unittests/TestLib.ProjectSystem.fs +++ b/vsintegration/tests/unittests/TestLib.ProjectSystem.fs @@ -9,7 +9,6 @@ open System.Runtime.Serialization open System.Collections.Generic open System.Text.RegularExpressions open System.Diagnostics -open Internal.Utilities.Debug open System.IO open System.Text open System.Xml.Linq @@ -17,10 +16,10 @@ open Salsa open Microsoft.Win32 +open Microsoft.VisualStudio open Microsoft.VisualStudio.FSharp.ProjectSystem open Microsoft.VisualStudio.Shell.Interop -open Microsoft.Build.BuildEngine open Microsoft.Build.Execution open Microsoft.Build.Framework diff --git a/vsintegration/tests/unittests/Tests.BaseLine.fs b/vsintegration/tests/unittests/Tests.BaseLine.fs deleted file mode 100644 index af766763185..00000000000 --- a/vsintegration/tests/unittests/Tests.BaseLine.fs +++ /dev/null @@ -1,57 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. - -namespace Tests -open NUnit.Framework -open System -open System.IO -open System.Diagnostics -open UnitTests.TestLib.Utils -open Microsoft.BuildSettings - -#if OPEN_BUILD -#else -[] -type Script() = - let replaceIfNotNull (search:string) (replace:string) (s:string) = - match s with - | null -> s - | s -> s.Replace(search,replace) - let replaceConstants(line:string) = - line - |> replaceIfNotNull Version.OfFile "{VersionOfFile}" - |> replaceIfNotNull Version.OfAssembly "{VersionOfAssembly}" - |> replaceIfNotNull Version.ProductBuild "{VersionOfProductBuild}" - |> replaceIfNotNull "4.0" "{DotNetMajorMinor}" - |> replaceIfNotNull "4.5" "{DotNetMajorMinor}" - |> replaceIfNotNull (sprintf "%s.%s" Version.Major Version.Minor) "{DotNetMajorMinor}" - |> replaceIfNotNull "10.0" "{VsMajorMinor}" - |> replaceIfNotNull "F# 3.0" "F# {FSharpCompilerVersion}" - |> replaceIfNotNull (Environment.GetEnvironmentVariable("ProgramFiles")) "{ProgramFiles}" - - let runCheck(script:string,baseline:string) = - let code,lines = Spawn.Batch script - let combinedLines = String.Join("\r\n",lines).Trim([|'\r';'\n'|]) |> replaceConstants - let baseline = baseline.Trim([|'\r';'\n'|]) - if baseline<>combinedLines then - for line in lines do - printfn "%s" (replaceConstants line) - Assert.AreEqual(baseline,combinedLines) - - [] - member public __.NetModules_Bug915449() = - let script = @" -@echo off -echo>a.cs public class A {} -echo>b.cs public class B {} -echo>r.fs let a = new A() -echo>>r.fs let b = new B() -echo>>r.fs System.Console.WriteLine(a.GetType()) -echo>>r.fs System.Console.WriteLine(b.GetType()) -csc /nologo /t:module a.cs -csc /nologo /t:module b.cs -al /nologo /out:c.dll a.netmodule b.netmodule -fsc /nologo /r:c.dll r.fs -" - let baseline = @"" - runCheck(script,baseline) -#endif \ No newline at end of file diff --git a/vsintegration/tests/unittests/Tests.Build.fs b/vsintegration/tests/unittests/Tests.Build.fs index 09975b2ab94..331f67f3aaf 100644 --- a/vsintegration/tests/unittests/Tests.Build.fs +++ b/vsintegration/tests/unittests/Tests.Build.fs @@ -7,7 +7,6 @@ open System open System.IO open System.Diagnostics open Microsoft.FSharp.Build -open Microsoft.Build.BuildEngine open Microsoft.Build.Framework open Microsoft.Build.Utilities open UnitTests.TestLib.Utils.FilesystemHelpers @@ -54,7 +53,7 @@ type FauxHostObject() = interface ITaskHost // no members -[] +[][] type Build() = (* Asserts ----------------------------------------------------------------------------- *) let AssertEqual expected actual = diff --git a/vsintegration/tests/unittests/Tests.InternalCollections.fs b/vsintegration/tests/unittests/Tests.InternalCollections.fs index 0fac842dd64..05eb6e99695 100644 --- a/vsintegration/tests/unittests/Tests.InternalCollections.fs +++ b/vsintegration/tests/unittests/Tests.InternalCollections.fs @@ -8,7 +8,7 @@ open NUnit.Framework open Internal.Utilities.Collections -[] +[][] type MruCache = new() = { } @@ -113,7 +113,7 @@ type MruCache = Assert.IsTrue(discarded.Value = ["y";"x";"Apple";"Banana"], "Check6") #endif -[] +[][] type AgedLookup() = let mutable hold197 : byte [] = null let mutable hold198 : byte [] = null diff --git a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs index 2d603c726b7..fc1e69ddc60 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs @@ -24,7 +24,7 @@ module StandardSettings = let AC x y = AutoCompleteExpected(x,y) let DC x y = DotCompleteExpected(x,y) -[] +[][] type UsingMSBuild() as this = inherit LanguageServiceBaseTests() @@ -7701,7 +7701,7 @@ let rec f l = // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) diff --git a/vsintegration/tests/unittests/Tests.LanguageService.ErrorList.fs b/vsintegration/tests/unittests/Tests.LanguageService.ErrorList.fs index 86be53980a5..71221617074 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.ErrorList.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.ErrorList.fs @@ -12,7 +12,7 @@ open UnitTests.TestLib.Utils open UnitTests.TestLib.LanguageService open UnitTests.TestLib.ProjectSystem -[] +[][] type UsingMSBuild() as this = inherit LanguageServiceBaseTests() @@ -876,8 +876,8 @@ but here has type member public this.``Warning.ConsistentWithLanguageService``() = let fileContent = """ open System - atomic atomic atomic atomic atomic atomic atomic atomic atomic atomic - atomic atomic atomic atomic atomic atomic atomic atomic atomic atomic""" + mixin mixin mixin mixin mixin mixin mixin mixin mixin mixin + mixin mixin mixin mixin mixin mixin mixin mixin mixin mixin""" let (_, project, file) = this.CreateSingleFileProject(fileContent, fileKind = SourceFileKind.FSX) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. let warnList = GetWarnings(project) @@ -887,8 +887,8 @@ but here has type member public this.``Warning.ConsistentWithLanguageService.Comment``() = let fileContent = """ open System - //atomic atomic atomic atomic atomic atomic atomic atomic atomic atomic - //atomic atomic atomic atomic atomic atomic atomic atomic atomic atomic""" + //mixin mixin mixin mixin mixin mixin mixin mixin mixin mixin + //mixin mixin mixin mixin mixin mixin mixin mixin mixin mixin""" let (_, project, file) = this.CreateSingleFileProject(fileContent, fileKind = SourceFileKind.FSX) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. let warnList = GetWarnings(project) @@ -910,6 +910,6 @@ but here has type Assert.AreEqual(1,warnList.Length) // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) diff --git a/vsintegration/tests/unittests/Tests.LanguageService.ErrorRecovery.fs b/vsintegration/tests/unittests/Tests.LanguageService.ErrorRecovery.fs index cc95a5dabd7..115d1969ec5 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.ErrorRecovery.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.ErrorRecovery.fs @@ -12,7 +12,7 @@ open UnitTests.TestLib.Utils open UnitTests.TestLib.LanguageService open UnitTests.TestLib.ProjectSystem -[] +[][] type UsingMSBuild() = inherit LanguageServiceBaseTests() @@ -266,6 +266,6 @@ type UsingMSBuild() = // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) \ No newline at end of file diff --git a/vsintegration/tests/unittests/Tests.LanguageService.F1Keyword.fs b/vsintegration/tests/unittests/Tests.LanguageService.F1Keyword.fs index a78ccc9ba86..b16c12998eb 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.F1Keyword.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.F1Keyword.fs @@ -11,7 +11,7 @@ open UnitTests.TestLib.Utils open UnitTests.TestLib.LanguageService open UnitTests.TestLib.ProjectSystem -[] +[][] type UsingMSBuild() = inherit LanguageServiceBaseTests() @@ -372,6 +372,6 @@ type UsingMSBuild() = // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) \ No newline at end of file diff --git a/vsintegration/tests/unittests/Tests.LanguageService.General.fs b/vsintegration/tests/unittests/Tests.LanguageService.General.fs index 264522638e1..0df43dcbd03 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.General.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.General.fs @@ -18,7 +18,7 @@ open UnitTests.TestLib.Utils open UnitTests.TestLib.LanguageService open UnitTests.TestLib.ProjectSystem -[] +[][] module IFSharpSource = [] @@ -55,7 +55,7 @@ module IFSharpSource = -[] +[][] type UsingMSBuild() = inherit LanguageServiceBaseTests() @@ -484,7 +484,7 @@ type UsingMSBuild() = // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) diff --git a/vsintegration/tests/unittests/Tests.LanguageService.GotoDefinition.fs b/vsintegration/tests/unittests/Tests.LanguageService.GotoDefinition.fs index f4cc7741cfa..3dda97f9c86 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.GotoDefinition.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.GotoDefinition.fs @@ -14,7 +14,7 @@ open System.Text.RegularExpressions open UnitTests.TestLib.LanguageService open UnitTests.TestLib.ProjectSystem -[] +[][] type UsingMSBuild() = inherit LanguageServiceBaseTests() @@ -1449,6 +1449,6 @@ type UsingMSBuild() = // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) diff --git a/vsintegration/tests/unittests/Tests.LanguageService.IncrementalBuild.fs b/vsintegration/tests/unittests/Tests.LanguageService.IncrementalBuild.fs index 41725a204fd..70a6f667bd2 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.IncrementalBuild.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.IncrementalBuild.fs @@ -24,7 +24,7 @@ module internal Vector = Vector.Demultiplex taskname Identity input -[] +[][] [] [] type IncrementalBuild() = diff --git a/vsintegration/tests/unittests/Tests.LanguageService.NavigationBar.fs b/vsintegration/tests/unittests/Tests.LanguageService.NavigationBar.fs index 223b5f5f3d3..fac1d1634c0 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.NavigationBar.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.NavigationBar.fs @@ -11,7 +11,7 @@ open UnitTests.TestLib.Utils open UnitTests.TestLib.LanguageService open UnitTests.TestLib.ProjectSystem -[] +[][] type UsingMSBuild() = inherit LanguageServiceBaseTests() @@ -220,6 +220,6 @@ type UsingMSBuild() = // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) \ No newline at end of file diff --git a/vsintegration/tests/unittests/Tests.LanguageService.ParameterInfo.fs b/vsintegration/tests/unittests/Tests.LanguageService.ParameterInfo.fs index 3608f4d0d24..4805130cdb2 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.ParameterInfo.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.ParameterInfo.fs @@ -16,7 +16,7 @@ module ParamInfoStandardSettings = let standard40AssemblyRefs = [| "System"; "System.Core"; "System.Numerics" |] let queryAssemblyRefs = [ "System.Xml.Linq"; "System.Core" ] -[] +[][] type UsingMSBuild() = inherit LanguageServiceBaseTests() @@ -2241,6 +2241,6 @@ We really need to rewrite some code paths here to use the real parse tree rather // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) diff --git a/vsintegration/tests/unittests/Tests.LanguageService.QuickInfo.fs b/vsintegration/tests/unittests/Tests.LanguageService.QuickInfo.fs index 902e23dd6a2..5cb8ab71a75 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.QuickInfo.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.QuickInfo.fs @@ -16,7 +16,7 @@ module QuickInfoStandardSettings = let standard40AssemblyRefs = [ "System"; "System.Core"; "System.Numerics" ] let queryAssemblyRefs = [ "System.Xml.Linq"; "System.Core" ] -[] +[][] type UsingMSBuild() = inherit LanguageServiceBaseTests() @@ -3679,6 +3679,6 @@ query." // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) diff --git a/vsintegration/tests/unittests/Tests.LanguageService.QuickParse.fs b/vsintegration/tests/unittests/Tests.LanguageService.QuickParse.fs index 953c0f9371c..1c7040c1f34 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.QuickParse.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.QuickParse.fs @@ -7,7 +7,7 @@ open System.IO open NUnit.Framework open Microsoft.VisualStudio.FSharp.LanguageService -[] +[][] [] [] type QuickParse() = diff --git a/vsintegration/tests/unittests/Tests.LanguageService.Script.fs b/vsintegration/tests/unittests/Tests.LanguageService.Script.fs index 3ef1233219e..d0df38bd98f 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.Script.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.Script.fs @@ -12,7 +12,7 @@ open UnitTests.TestLib.Utils open UnitTests.TestLib.LanguageService open UnitTests.TestLib.ProjectSystem -[] +[][] type UsingMSBuild() as this = inherit LanguageServiceBaseTests() @@ -1237,8 +1237,6 @@ type UsingMSBuild() as this = Assert.AreEqual(Path.Combine(projectFolder,"File1.fsx"), fas.ProjectFileNames.[0]) Assert.AreEqual(1, fas.ProjectFileNames.Length) -#if OPEN_BUILD -#else /// FEATURE: #reference against a strong name should work. [] @@ -1246,7 +1244,7 @@ type UsingMSBuild() as this = let code = ["#light" #if FX_ATLEAST_40 - sprintf "#reference \"System.Core, Version=%s, Culture=neutral, PublicKeyToken=b77a5c561934e089\"" Microsoft.BuildSettings.Version.OfAssembly + sprintf "#reference \"System.Core, Version=%s, Culture=neutral, PublicKeyToken=b77a5c561934e089\"" (System.Environment.Version.ToString()) #else "#reference \"System.Core, Version=3.5.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089\"" #endif @@ -1255,7 +1253,7 @@ type UsingMSBuild() as this = MoveCursorToEndOfMarker(file,"open System.") let completions = AutoCompleteAtCursor file AssertCompListContains(completions,"Linq") -#endif + /// Try out some bogus file names in #r, #I and #load. [] @@ -1719,7 +1717,7 @@ type UsingMSBuild() as this = // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) diff --git a/vsintegration/tests/unittests/Tests.LanguageService.Squiggles.fs b/vsintegration/tests/unittests/Tests.LanguageService.Squiggles.fs index 97e51a3e0e0..fc9771ccfd2 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.Squiggles.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.Squiggles.fs @@ -12,7 +12,7 @@ open UnitTests.TestLib.Utils open UnitTests.TestLib.LanguageService open UnitTests.TestLib.ProjectSystem -[] +[][] type UsingMSBuild() as this= inherit LanguageServiceBaseTests() @@ -950,6 +950,6 @@ type X() = // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) diff --git a/vsintegration/tests/unittests/Tests.LanguageService.TimeStamp.fs b/vsintegration/tests/unittests/Tests.LanguageService.TimeStamp.fs index 132a3484b6a..4f80182c7c1 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.TimeStamp.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.TimeStamp.fs @@ -11,7 +11,7 @@ open UnitTests.TestLib.Salsa open UnitTests.TestLib.Utils open UnitTests.TestLib.LanguageService -[] +[][] type UsingMSBuild() = inherit LanguageServiceBaseTests() @@ -325,6 +325,6 @@ open NUnit.Framework open Salsa.Salsa // Context project system -[] +[][] type UsingProjectSystem() = inherit UsingMSBuild(VsOpts = LanguageServiceExtension.ProjectSystemTestFlavour) \ No newline at end of file diff --git a/vsintegration/tests/unittests/Tests.Powerpack.fs b/vsintegration/tests/unittests/Tests.Powerpack.fs index 677978711f3..a93f7f57fbe 100644 --- a/vsintegration/tests/unittests/Tests.Powerpack.fs +++ b/vsintegration/tests/unittests/Tests.Powerpack.fs @@ -7,7 +7,6 @@ open System open System.IO open System.Diagnostics open Microsoft.FSharp.Build -open Microsoft.Build.BuildEngine open Microsoft.Build.Framework open Microsoft.Build.Utilities open UnitTests.TestLib.Utils.FilesystemHelpers diff --git a/vsintegration/tests/unittests/Tests.ProjectSystem.Configs.fs b/vsintegration/tests/unittests/Tests.ProjectSystem.Configs.fs index 9ac1560a56b..eef2b7bb495 100644 --- a/vsintegration/tests/unittests/Tests.ProjectSystem.Configs.fs +++ b/vsintegration/tests/unittests/Tests.ProjectSystem.Configs.fs @@ -11,6 +11,7 @@ open System.Xml.Linq open NUnit.Framework // VS namespaces +open Microsoft.VisualStudio open Microsoft.VisualStudio.Shell.Interop open Microsoft.VisualStudio.FSharp.ProjectSystem @@ -21,7 +22,7 @@ open UnitTests.TestLib.Utils.FilesystemHelpers open UnitTests.TestLib.ProjectSystem -[] +[][] type Config() = inherit TheTests() diff --git a/vsintegration/tests/unittests/Tests.ProjectSystem.Miscellaneous.fs b/vsintegration/tests/unittests/Tests.ProjectSystem.Miscellaneous.fs index 7a584aa56d1..4c7975cb465 100644 --- a/vsintegration/tests/unittests/Tests.ProjectSystem.Miscellaneous.fs +++ b/vsintegration/tests/unittests/Tests.ProjectSystem.Miscellaneous.fs @@ -11,6 +11,7 @@ open System.Text open System.Text.RegularExpressions // VS namespaces +open Microsoft.VisualStudio open Microsoft.VisualStudio.Shell open Microsoft.VisualStudio.Shell.Interop open Microsoft.VisualStudio.FSharp.ProjectSystem @@ -22,7 +23,7 @@ open UnitTests.TestLib.Utils.Asserts open UnitTests.TestLib.Utils.FilesystemHelpers open UnitTests.TestLib.ProjectSystem -[] +[][] type Miscellaneous() = inherit TheTests() @@ -678,7 +679,7 @@ module Regression5312 = let icons = extractIcon path true if icons.Length<>nExpected then failwithf "Expected %d icons in %s" nExpected path // " -[] +[][] type Utilities() = (* Simulation of the code found in Xaml editor that we were crashing. The relevent code is pasted below. diff --git a/vsintegration/tests/unittests/Tests.ProjectSystem.MultiTargeting.fs b/vsintegration/tests/unittests/Tests.ProjectSystem.MultiTargeting.fs index 0cd5d5815fc..fcdaf4bdc14 100644 --- a/vsintegration/tests/unittests/Tests.ProjectSystem.MultiTargeting.fs +++ b/vsintegration/tests/unittests/Tests.ProjectSystem.MultiTargeting.fs @@ -16,7 +16,7 @@ open UnitTests.TestLib.ProjectSystem open Microsoft.VisualStudio.FSharp.ProjectSystem -[] +[][] type MultiTargeting() = inherit TheTests() diff --git a/vsintegration/tests/unittests/Tests.ProjectSystem.Project.fs b/vsintegration/tests/unittests/Tests.ProjectSystem.Project.fs index a7cc5bc614d..b3f85d092bf 100644 --- a/vsintegration/tests/unittests/Tests.ProjectSystem.Project.fs +++ b/vsintegration/tests/unittests/Tests.ProjectSystem.Project.fs @@ -11,6 +11,7 @@ open System.Xml.Linq open NUnit.Framework // VS namespaces +open Microsoft.VisualStudio open Microsoft.VisualStudio.Shell.Interop open Microsoft.VisualStudio.FSharp.ProjectSystem @@ -21,7 +22,7 @@ open UnitTests.TestLib.Utils.FilesystemHelpers open UnitTests.TestLib.ProjectSystem -[] +[][] type Project() = inherit TheTests() diff --git a/vsintegration/tests/unittests/Tests.ProjectSystem.ProjectItems.fs b/vsintegration/tests/unittests/Tests.ProjectSystem.ProjectItems.fs index 5264eebbca2..8e808f394ad 100644 --- a/vsintegration/tests/unittests/Tests.ProjectSystem.ProjectItems.fs +++ b/vsintegration/tests/unittests/Tests.ProjectSystem.ProjectItems.fs @@ -10,7 +10,7 @@ open UnitTests.TestLib.ProjectSystem open Microsoft.VisualStudio.FSharp.ProjectSystem -[] +[][] type ProjectItems() = inherit TheTests() diff --git a/vsintegration/tests/unittests/Tests.ProjectSystem.References.fs b/vsintegration/tests/unittests/Tests.ProjectSystem.References.fs index 9d0bcbeb1d9..399204c9b47 100644 --- a/vsintegration/tests/unittests/Tests.ProjectSystem.References.fs +++ b/vsintegration/tests/unittests/Tests.ProjectSystem.References.fs @@ -13,12 +13,13 @@ open UnitTests.TestLib.Utils.Asserts open UnitTests.TestLib.Utils.FilesystemHelpers open UnitTests.TestLib.ProjectSystem +open Microsoft.VisualStudio open Microsoft.VisualStudio.FSharp.ProjectSystem open Microsoft.VisualStudio.Shell.Interop open Microsoft.Win32 open System.Xml.Linq -[] +[][] type References() = inherit TheTests() diff --git a/vsintegration/tests/unittests/Tests.ProjectSystem.RoundTrip.fs b/vsintegration/tests/unittests/Tests.ProjectSystem.RoundTrip.fs index 1b294410bbb..0f93e69c281 100644 --- a/vsintegration/tests/unittests/Tests.ProjectSystem.RoundTrip.fs +++ b/vsintegration/tests/unittests/Tests.ProjectSystem.RoundTrip.fs @@ -12,7 +12,7 @@ open UnitTests.TestLib.ProjectSystem open Microsoft.VisualStudio.FSharp.ProjectSystem -[] +[][] type RoundTrip() = inherit TheTests() diff --git a/vsintegration/tests/unittests/Tests.ProjectSystem.UpToDate.fs b/vsintegration/tests/unittests/Tests.ProjectSystem.UpToDate.fs index 5e0550d26bd..2c9260f20a4 100644 --- a/vsintegration/tests/unittests/Tests.ProjectSystem.UpToDate.fs +++ b/vsintegration/tests/unittests/Tests.ProjectSystem.UpToDate.fs @@ -11,6 +11,7 @@ open System.Text open System.Text.RegularExpressions // VS namespaces +open Microsoft.VisualStudio open Microsoft.VisualStudio.Shell open Microsoft.VisualStudio.Shell.Interop open Microsoft.VisualStudio.FSharp.ProjectSystem @@ -22,7 +23,7 @@ open UnitTests.TestLib.Utils.Asserts open UnitTests.TestLib.Utils.FilesystemHelpers open UnitTests.TestLib.ProjectSystem -[] +[][] type UpToDate() = inherit TheTests() @@ -379,7 +380,7 @@ type UpToDate() = |> List.iter (fun (flag, expected) -> testFlag flag expected) )) -[] +[][] type ``UpToDate PreserveNewest`` () = [] diff --git a/vsintegration/tests/unittests/Tests.Roslyn.BraceMatchingService.fs b/vsintegration/tests/unittests/Tests.Roslyn.BraceMatchingService.fs index ae4a698c2a7..340dc3efae1 100644 --- a/vsintegration/tests/unittests/Tests.Roslyn.BraceMatchingService.fs +++ b/vsintegration/tests/unittests/Tests.Roslyn.BraceMatchingService.fs @@ -116,4 +116,4 @@ type BraceMatchingServiceTests() = let x = \"stringValue\" + (endsInString + \" )endsInString startsInString" - this.VerifyNoBraceMatch(code, startMarker) + this.VerifyNoBraceMatch(code, startMarker) \ No newline at end of file diff --git a/vsintegration/tests/unittests/Tests.Roslyn.ColorizationService.fs b/vsintegration/tests/unittests/Tests.Roslyn.ColorizationService.fs index 585a0a04c41..2116d538da0 100644 --- a/vsintegration/tests/unittests/Tests.Roslyn.ColorizationService.fs +++ b/vsintegration/tests/unittests/Tests.Roslyn.ColorizationService.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn open System @@ -1053,4 +1053,4 @@ type ColorizationServiceTests() = fileContents = "(*Bob*)type Bob() = int", marker = "(*Bob*)typ", defines = [], - classificationType = ClassificationTypeNames.Keyword) + classificationType = ClassificationTypeNames.Keyword) \ No newline at end of file diff --git a/vsintegration/tests/unittests/Tests.TaskReporter.fs b/vsintegration/tests/unittests/Tests.TaskReporter.fs index 5bc53a95b53..a87f47b21a5 100644 --- a/vsintegration/tests/unittests/Tests.TaskReporter.fs +++ b/vsintegration/tests/unittests/Tests.TaskReporter.fs @@ -7,7 +7,6 @@ open System open System.IO open System.Diagnostics open Microsoft.FSharp.Build -open Microsoft.Build.BuildEngine open Microsoft.Build.Framework open Microsoft.Build.Utilities open UnitTests.TestLib.Utils @@ -20,7 +19,7 @@ open Salsa.VsMocks type TextSpan = Microsoft.VisualStudio.TextManager.Interop.TextSpan type DocumentTask = Microsoft.VisualStudio.FSharp.LanguageService.DocumentTask -[] +[][] type TaskReporter() = static let err(line) : 'a = printfn "err() called on line %s with %s" line System.Environment.StackTrace diff --git a/vsintegration/tests/unittests/Tests.Watson.fs b/vsintegration/tests/unittests/Tests.Watson.fs index 00013946b78..f3ce4c3c68b 100644 --- a/vsintegration/tests/unittests/Tests.Watson.fs +++ b/vsintegration/tests/unittests/Tests.Watson.fs @@ -39,7 +39,7 @@ type Check = File.Delete("watson-test.fs") -[] +[][] module WatsonTests = [] diff --git a/vsintegration/tests/unittests/Tests.XmlDocComments.fs b/vsintegration/tests/unittests/Tests.XmlDocComments.fs index 962b84eb471..e2d7fe77a74 100644 --- a/vsintegration/tests/unittests/Tests.XmlDocComments.fs +++ b/vsintegration/tests/unittests/Tests.XmlDocComments.fs @@ -9,7 +9,7 @@ open Salsa.VsOpsUtils open UnitTests.TestLib.Salsa open UnitTests.TestLib.Utils -[] +[][] type XmlDocComments() = inherit UnitTests.TestLib.LanguageService.LanguageServiceBaseTests(VsOpts = InstalledMSBuildTestFlavour()) // Work around an innocuous 'feature' with how QuickInfo is displayed, lines which diff --git a/vsintegration/tests/unittests/VisualFSharp.Unittests.fsproj b/vsintegration/tests/unittests/VisualFSharp.Unittests.fsproj index 3dcbee7721f..2854fcb34a4 100644 --- a/vsintegration/tests/unittests/VisualFSharp.Unittests.fsproj +++ b/vsintegration/tests/unittests/VisualFSharp.Unittests.fsproj @@ -6,7 +6,6 @@ FSharp true VisualFSharp.Unittests - v4.6 @@ -34,9 +33,10 @@ + + - @@ -84,8 +84,6 @@ VisualFSharp.Unittests.dll.config - - @@ -101,55 +99,87 @@ - - - - + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Framework.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Utilities.Core.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualFSharp.Msbuild.15.0.1.0.0\lib\net45\Microsoft.Build.Tasks.Core.dll + - - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.UI.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Threading.14.1.131\lib\net45\Microsoft.VisualStudio.Threading.dll - - - - - $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.14.2.25123\lib\net45\Microsoft.VisualStudio.Text.Data.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.UI.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.UI.dll + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Text.Data.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Text.Data.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.Design.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.Shell.Design.dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll + + + $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.CoreUtility.$(RoslynVSPackagesVersion)\lib\net45\Microsoft.VisualStudio.CoreUtility.dll + + + - - + + True + $(NUnitLibDir)\nunit.framework.dll + $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Common.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.dll + True $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.EditorFeatures.$(RoslynVersion)\lib\net46\Microsoft.CodeAnalysis.EditorFeatures.dll + True $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.EditorFeatures.Text.$(RoslynVersion)\lib\net46\Microsoft.CodeAnalysis.EditorFeatures.Text.dll + True + + + $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Features.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.Features.dll + True $(FSharpSourcesRoot)\..\packages\Microsoft.CodeAnalysis.Workspaces.Common.$(RoslynVersion)\lib\net45\Microsoft.CodeAnalysis.Workspaces.dll + True $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.LanguageServices.$(RoslynVersion)\lib\net46\Microsoft.VisualStudio.LanguageServices.dll + True - + + $(FSharpSourcesRoot)\..\packages\Microsoft.Composition.1.0.27\lib\portable-net45+win8+wp8+wpa81\System.Composition.AttributedModel.dll + True + + + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0-rc3-23805\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll True - $(NUnitLibDir)\nunit.framework.dll {DED3BBD7-53F4-428A-8C9F-27968E768605} @@ -165,11 +195,6 @@ {a437a6ec-5323-47c2-8f86-e2cac54ff152} True - - FSharp.Editor - {65e0e82a-eace-4787-8994-888674c2fe87} - True - VisualFSharp.Salsa {fbd4b354-dc6e-4032-8ec7-c81d8dfb1af7} @@ -195,6 +220,11 @@ {6196B0F8-CAEA-4CF1-AF82-1B520F77FE44} True + + FSharp.Editor + {65e0e82a-eace-4787-8994-888674c2fe87} + True + \ No newline at end of file