diff --git a/.vsts-pr.yaml b/.vsts-pr.yaml new file mode 100644 index 0000000000..67f78e6df0 --- /dev/null +++ b/.vsts-pr.yaml @@ -0,0 +1,59 @@ +phases: +- phase: Linux + queue: + name: Hosted Linux Preview + timeoutInMinutes: 90 + parallel: 2 + matrix: + release_default: + _command: ./mono/cibuild.sh + _args: release + release_fcs: + _command: ./fcs/build.sh + _args: Build + steps: + - script: $(_command) $(_args) + - task: PublishBuildArtifacts@1 + inputs: + PathtoPublish: '$(Build.SourcesDirectory)/tests/TestResults' + ArtifactName: 'Linux $(_command) $(_args)' + publishLocation: Container + continueOnError: true + condition: failed() + +- phase: Windows + queue: + name: Hosted VS2017 + timeoutInMinutes: 90 + parallel: 7 + matrix: + ci_part1: + _command: build.cmd + _args: release ci_part1 + ci_part2: + _command: build.cmd + _args: release ci_part2 + ci_part3: + _command: build.cmd + _args: release ci_part3 + ci_part4: + _command: build.cmd + _args: release ci_part4 + debug_default: + _command: build.cmd + _args: debug + net40_no_vs: + _command: build.cmd + _args: release net40 + release_fcs: + _command: fcs\build.cmd + _args: TestAndNuget + steps: + - script: $(_command) $(_args) + - task: PublishBuildArtifacts@1 + inputs: + PathtoPublish: '$(Build.SourcesDirectory)\tests\TestResults' + ArtifactName: 'Windows $(_command) $(_args)' + publishLocation: Container + continueOnError: true + condition: failed() diff --git a/README.md b/README.md index a55773f8e3..2f13f83520 100644 --- a/README.md +++ b/README.md @@ -56,7 +56,9 @@ This project is subject to the MIT License. A copy of this license can be found Maintainers ----------- -The maintainers of this repository from the F# Core Engineering Group are: +The maintainers of this repository are: - - [Don Syme](http://github.com/dsyme), [Tomas Petricek](http://github.com/tpetricek), [Enrico Sada](http://github.com/enricosada) - - with help and guidance from [Robin Neatherway](https://github.com/rneatherway), [Dave Thomas](http://github.com/7sharp9), [Lincoln Atkinson](http://github.com/latkin), [Kevin Ransom](http://github.com/KevinRansom), [Vladimir Matveev](http://github.com/vladima) and others + - [Don Syme](http://github.com/dsyme) + - [Tomas Petricek](http://github.com/tpetricek) + - [Enrico Sada](http://github.com/enricosada) + - Many people have helped including [Robin Neatherway](https://github.com/rneatherway), [Dave Thomas](http://github.com/7sharp9), [Lincoln Atkinson](http://github.com/latkin), [Kevin Ransom](http://github.com/KevinRansom), [Vladimir Matveev](http://github.com/vladima) and others diff --git a/fcs/.gitignore b/fcs/.gitignore index 176f453284..51023f1bf5 100644 --- a/fcs/.gitignore +++ b/fcs/.gitignore @@ -1,3 +1,4 @@ +FSharp.Compiler.Service.Tests/TestResults/* FSharp.Compiler.Service.netstandard/illex.fs FSharp.Compiler.Service.netstandard/ilpars.fs FSharp.Compiler.Service.netstandard/ilpars.fsi diff --git a/fcs/FSharp.Compiler.Service.MSBuild.v12/FSharp.Compiler.Service.MSBuild.v12.fsproj b/fcs/FSharp.Compiler.Service.MSBuild.v12/FSharp.Compiler.Service.MSBuild.v12.fsproj index c4d28bb385..deb3f51b69 100644 --- a/fcs/FSharp.Compiler.Service.MSBuild.v12/FSharp.Compiler.Service.MSBuild.v12.fsproj +++ b/fcs/FSharp.Compiler.Service.MSBuild.v12/FSharp.Compiler.Service.MSBuild.v12.fsproj @@ -6,6 +6,7 @@ net45 + true ..\..\$(Configuration.ToLower())\fcs $(DefineConstants);CROSS_PLATFORM_COMPILER $(DefineConstants);ENABLE_MONO_SUPPORT @@ -28,7 +29,7 @@ - + $(FSharpSourcesRoot)\..\fcs\dependencies\MSBuild.v12.0\Microsoft.Build.Framework.dll diff --git a/fcs/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj b/fcs/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj index 49f45fec71..ff23a6589c 100644 --- a/fcs/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj +++ b/fcs/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj @@ -6,6 +6,7 @@ net45 + true ..\..\$(Configuration.ToLower())\fcs @@ -30,7 +31,7 @@ - + \ No newline at end of file diff --git a/fcs/FSharp.Compiler.Service.ProjectCrackerTool/FSharp.Compiler.Service.ProjectCrackerTool.fsproj b/fcs/FSharp.Compiler.Service.ProjectCrackerTool/FSharp.Compiler.Service.ProjectCrackerTool.fsproj index 7a29df47b0..f6ff4d1bea 100644 --- a/fcs/FSharp.Compiler.Service.ProjectCrackerTool/FSharp.Compiler.Service.ProjectCrackerTool.fsproj +++ b/fcs/FSharp.Compiler.Service.ProjectCrackerTool/FSharp.Compiler.Service.ProjectCrackerTool.fsproj @@ -8,6 +8,7 @@ Exe net45 + true $(DefineConstants);CROSS_PLATFORM_COMPILER $(DefineConstants);ENABLE_MONO_SUPPORT $(OtherFlags) --staticlink:FSharp.Core @@ -28,7 +29,7 @@ $(FSharpSourcesRoot)\..\packages\Microsoft.Portable.FSharp.Core.$(FSharpCoreFrozenPortablePackageVersion)\lib\profiles\net40\FSharp.Core.dll false - + $(FSharpSourcesRoot)\..\fcs\dependencies\MSBuild.v12.0\Microsoft.Build.Framework.dll false diff --git a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index 7fcce1b725..7ea85c202a 100644 --- a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -6,6 +6,7 @@ net46;netcoreapp2.0 + true $(NoWarn);44;75; true true @@ -74,7 +75,7 @@ - + diff --git a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index aa7f0afa78..a642413653 100644 --- a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -6,6 +6,7 @@ net45;netstandard2.0 + true $(DefineConstants);COMPILER_SERVICE_AS_DLL $(DefineConstants);COMPILER $(DefineConstants);ENABLE_MONO_SUPPORT @@ -634,9 +635,9 @@ - - - + + + diff --git a/fcs/README.md b/fcs/README.md index 661ac76351..f348a934ff 100644 --- a/fcs/README.md +++ b/fcs/README.md @@ -60,9 +60,9 @@ which does things like: You can push the packages if you have permissions, either automatically using ``build Release`` or manually set APIKEY=... - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.24.0.1.nupkg %APIKEY% -Source https://nuget.org - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.MSBuild.v12.24.0.1.nupkg %APIKEY% -Source https://nuget.org - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.ProjectCracker.24.0.1.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.25.0.1.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.MSBuild.v12.25.0.1.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.ProjectCracker.25.0.1.nupkg %APIKEY% -Source https://nuget.org ### Use of Paket and FAKE diff --git a/fcs/RELEASE_NOTES.md b/fcs/RELEASE_NOTES.md index 2b323ba496..b1e1f640c5 100644 --- a/fcs/RELEASE_NOTES.md +++ b/fcs/RELEASE_NOTES.md @@ -1,3 +1,6 @@ +#### 25.0.1 + * Integrate visualfsharp master to 15d9391e78c554f91824d2be2e69938cd811df68 + #### 24.0.1 * Integrate visualfsharp master to 59156db2d0a744233d1baffee7088ca2d9f959c7 diff --git a/fcs/build.fsx b/fcs/build.fsx index 66c30f5c0f..a11ed814af 100644 --- a/fcs/build.fsx +++ b/fcs/build.fsx @@ -74,11 +74,13 @@ Target "Restore" (fun _ -> // We assume a paket restore has already been run runDotnet __SOURCE_DIRECTORY__ "restore FSharp.Compiler.Service.sln -v n" for p in [ "../packages.config" ] do - ExecProcess (fun info -> - info.FileName <- FullName @"./../.nuget/NuGet.exe" - info.WorkingDirectory <- FullName @"./.." - info.Arguments <- sprintf "restore %s -PackagesDirectory \"%s\" -ConfigFile \"%s\"" (FullName p) (FullName "./../packages") (FullName "./../NuGet.Config")) TimeSpan.MaxValue - |> assertExitCodeZero + let rec executeProcess count = + let result = ExecProcess (fun info -> + info.FileName <- FullName @"./../.nuget/NuGet.exe" + info.WorkingDirectory <- FullName @"./.." + info.Arguments <- sprintf "restore %s -PackagesDirectory \"%s\" -ConfigFile \"%s\"" (FullName p) (FullName "./../packages") (FullName "./../NuGet.Config")) TimeSpan.MaxValue + if result <> 0 && count > 1 then executeProcess (count - 1) else result + (executeProcess 5) |> assertExitCodeZero ) Target "BuildVersion" (fun _ -> diff --git a/fcs/fcs.props b/fcs/fcs.props index 4802bd2431..b698937373 100644 --- a/fcs/fcs.props +++ b/fcs/fcs.props @@ -3,7 +3,7 @@ - 24.0.1 + 25.0.1 --version:$(VersionPrefix) false diff --git a/fcs/samples/EditorService/EditorService.fsproj b/fcs/samples/EditorService/EditorService.fsproj index f68de82cb0..05847e67f9 100644 --- a/fcs/samples/EditorService/EditorService.fsproj +++ b/fcs/samples/EditorService/EditorService.fsproj @@ -3,6 +3,7 @@ net46;netcoreapp2.0 + true Exe false @@ -13,7 +14,7 @@ - + diff --git a/fcs/samples/FscExe/FscExe.fsproj b/fcs/samples/FscExe/FscExe.fsproj index 253ba8c7cc..c482656827 100644 --- a/fcs/samples/FscExe/FscExe.fsproj +++ b/fcs/samples/FscExe/FscExe.fsproj @@ -3,6 +3,7 @@ net46 + true Exe false $(DefineConstants);RESIDENT_COMPILER diff --git a/fcs/samples/FsiExe/FsiExe.fsproj b/fcs/samples/FsiExe/FsiExe.fsproj index c0468d9feb..7377f2c291 100644 --- a/fcs/samples/FsiExe/FsiExe.fsproj +++ b/fcs/samples/FsiExe/FsiExe.fsproj @@ -3,6 +3,7 @@ net46 + true Exe false diff --git a/fcs/samples/InteractiveService/InteractiveService.fsproj b/fcs/samples/InteractiveService/InteractiveService.fsproj index bae4532d87..7aa4249726 100644 --- a/fcs/samples/InteractiveService/InteractiveService.fsproj +++ b/fcs/samples/InteractiveService/InteractiveService.fsproj @@ -3,6 +3,7 @@ net46 + true Exe false diff --git a/fcs/samples/Tokenizer/Tokenizer.fsproj b/fcs/samples/Tokenizer/Tokenizer.fsproj index bae4532d87..7aa4249726 100644 --- a/fcs/samples/Tokenizer/Tokenizer.fsproj +++ b/fcs/samples/Tokenizer/Tokenizer.fsproj @@ -3,6 +3,7 @@ net46 + true Exe false diff --git a/fcs/samples/UntypedTree/UntypedTree.fsproj b/fcs/samples/UntypedTree/UntypedTree.fsproj index bae4532d87..7aa4249726 100644 --- a/fcs/samples/UntypedTree/UntypedTree.fsproj +++ b/fcs/samples/UntypedTree/UntypedTree.fsproj @@ -3,6 +3,7 @@ net46 + true Exe false diff --git a/packages.config b/packages.config index 58b426f36a..25a939155f 100644 --- a/packages.config +++ b/packages.config @@ -8,16 +8,22 @@ - - - + + + - + + + + + + + @@ -27,6 +33,7 @@ + diff --git a/src/absil/il.fs b/src/absil/il.fs index 180a170f20..c2314418fe 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -1228,6 +1228,7 @@ type ILMethodBody = [] type ILMemberAccess = | Assembly + | CompilerControlled | FamilyAndAssembly | FamilyOrAssembly | Family @@ -1546,7 +1547,7 @@ let memberAccessOfFlags flags = elif f = 0x00000002 then ILMemberAccess.FamilyAndAssembly elif f = 0x00000005 then ILMemberAccess.FamilyOrAssembly elif f = 0x00000003 then ILMemberAccess.Assembly - else failwith "impossible: the flags parameter value is come from enums MethodAttributes and FieldAttributes must have access flag" + else ILMemberAccess.CompilerControlled let convertMemberAccess (ilMemberAccess:ILMemberAccess) = match ilMemberAccess with @@ -1554,6 +1555,7 @@ let convertMemberAccess (ilMemberAccess:ILMemberAccess) = | ILMemberAccess.Private -> MethodAttributes.Private | ILMemberAccess.Assembly -> MethodAttributes.Assembly | ILMemberAccess.FamilyAndAssembly -> MethodAttributes.FamANDAssem + | ILMemberAccess.CompilerControlled -> MethodAttributes.PrivateScope | ILMemberAccess.FamilyOrAssembly -> MethodAttributes.FamORAssem | ILMemberAccess.Family -> MethodAttributes.Family @@ -1805,6 +1807,7 @@ type ILPropertyDefs = let convertFieldAccess (ilMemberAccess:ILMemberAccess) = match ilMemberAccess with | ILMemberAccess.Assembly -> FieldAttributes.Assembly + | ILMemberAccess.CompilerControlled -> enum(0) | ILMemberAccess.FamilyAndAssembly -> FieldAttributes.FamANDAssem | ILMemberAccess.FamilyOrAssembly -> FieldAttributes.FamORAssem | ILMemberAccess.Family -> FieldAttributes.Family @@ -1946,6 +1949,7 @@ let convertTypeAccessFlags access = | ILTypeDefAccess.Nested ILMemberAccess.Public -> TypeAttributes.NestedPublic | ILTypeDefAccess.Nested ILMemberAccess.Private -> TypeAttributes.NestedPrivate | ILTypeDefAccess.Nested ILMemberAccess.Family -> TypeAttributes.NestedFamily + | ILTypeDefAccess.Nested ILMemberAccess.CompilerControlled -> TypeAttributes.NestedPrivate | ILTypeDefAccess.Nested ILMemberAccess.FamilyAndAssembly -> TypeAttributes.NestedFamANDAssem | ILTypeDefAccess.Nested ILMemberAccess.FamilyOrAssembly -> TypeAttributes.NestedFamORAssem | ILTypeDefAccess.Nested ILMemberAccess.Assembly -> TypeAttributes.NestedAssembly @@ -1973,6 +1977,7 @@ let convertEncoding encoding = let convertToNestedTypeAccess (ilMemberAccess:ILMemberAccess) = match ilMemberAccess with | ILMemberAccess.Assembly -> TypeAttributes.NestedAssembly + | ILMemberAccess.CompilerControlled -> failwith "Method access compiler controlled." | ILMemberAccess.FamilyAndAssembly -> TypeAttributes.NestedFamANDAssem | ILMemberAccess.FamilyOrAssembly -> TypeAttributes.NestedFamORAssem | ILMemberAccess.Family -> TypeAttributes.NestedFamily diff --git a/src/absil/il.fsi b/src/absil/il.fsi index fe0bd1bdac..6ed4d42aa3 100755 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -720,6 +720,7 @@ type ILMethodBody = [] type ILMemberAccess = | Assembly + | CompilerControlled | FamilyAndAssembly | FamilyOrAssembly | Family diff --git a/src/absil/ilprint.fs b/src/absil/ilprint.fs index 6dff9315c7..f11524bc8d 100755 --- a/src/absil/ilprint.fs +++ b/src/absil/ilprint.fs @@ -397,6 +397,7 @@ let output_member_access os access = | ILMemberAccess.Public -> "public" | ILMemberAccess.Private -> "private" | ILMemberAccess.Family -> "family" + | ILMemberAccess.CompilerControlled -> "privatescope" | ILMemberAccess.FamilyAndAssembly -> "famandassem" | ILMemberAccess.FamilyOrAssembly -> "famorassem" | ILMemberAccess.Assembly -> "assembly") diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index 95194aea5a..c07408e8ab 100755 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -1724,6 +1724,7 @@ let typeAttrbutesOfTypeAccess x = | ILTypeDefAccess.Nested macc -> match macc with | ILMemberAccess.Assembly -> TypeAttributes.NestedAssembly + | ILMemberAccess.CompilerControlled -> failwith "Nested compiler controled." | ILMemberAccess.FamilyAndAssembly -> TypeAttributes.NestedFamANDAssem | ILMemberAccess.FamilyOrAssembly -> TypeAttributes.NestedFamORAssem | ILMemberAccess.Family -> TypeAttributes.NestedFamily diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index 9ce53c29c5..d28348bf86 100755 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -1074,6 +1074,7 @@ let GetMemberAccessFlags access = | ILMemberAccess.Public -> 0x00000006 | ILMemberAccess.Private -> 0x00000001 | ILMemberAccess.Family -> 0x00000004 + | ILMemberAccess.CompilerControlled -> 0x00000000 | ILMemberAccess.FamilyAndAssembly -> 0x00000002 | ILMemberAccess.FamilyOrAssembly -> 0x00000005 | ILMemberAccess.Assembly -> 0x00000003 @@ -1085,6 +1086,7 @@ let GetTypeAccessFlags access = | ILTypeDefAccess.Nested ILMemberAccess.Public -> 0x00000002 | ILTypeDefAccess.Nested ILMemberAccess.Private -> 0x00000003 | ILTypeDefAccess.Nested ILMemberAccess.Family -> 0x00000004 + | ILTypeDefAccess.Nested ILMemberAccess.CompilerControlled -> failwith "bad type acccess" | ILTypeDefAccess.Nested ILMemberAccess.FamilyAndAssembly -> 0x00000006 | ILTypeDefAccess.Nested ILMemberAccess.FamilyOrAssembly -> 0x00000007 | ILTypeDefAccess.Nested ILMemberAccess.Assembly -> 0x00000005 @@ -2524,7 +2526,8 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) = SequencePoints=seqpoints } cenv.AddCode code addr - | MethodBody.Abstract -> + | MethodBody.Abstract + | MethodBody.PInvoke _ -> // Now record the PDB record for this method - we write this out later. if cenv.generatePdb then cenv.pdbinfo.Add diff --git a/src/absil/ilwritepdb.fs b/src/absil/ilwritepdb.fs index f90630a396..61771a9b2d 100644 --- a/src/absil/ilwritepdb.fs +++ b/src/absil/ilwritepdb.fs @@ -416,10 +416,16 @@ let generatePortablePdb (embedAllSource:bool) (embedSourceList:string list) (sou let collectScopes scope = let list = new List() - let rec toList scope = - list.Add scope - scope.Children |> Seq.iter(fun s -> toList s) - toList scope + let rec toList scope parent = + let nested = + match parent with + | Some p -> scope.StartOffset <> p.StartOffset || scope.EndOffset <> p.EndOffset + | None -> true + + if nested then list.Add scope + scope.Children |> Seq.iter(fun s -> toList s (if nested then Some scope else parent)) + + toList scope None list.ToArray() |> Array.sortWith scopeSorter collectScopes scope |> Seq.iter(fun s -> @@ -449,8 +455,8 @@ let generatePortablePdb (embedAllSource:bool) (embedSourceList:string list) (sou let convert (content:IEnumerable) = use sha = System.Security.Cryptography.SHA1.Create() // IncrementalHash is core only let hash = content - |> Seq.map ( fun c -> c.GetBytes().Array |> sha.ComputeHash ) - |> Seq.collect id |> Array.ofSeq |> sha.ComputeHash + |> Seq.collect (fun c -> c.GetBytes().Array |> sha.ComputeHash) + |> Array.ofSeq |> sha.ComputeHash BlobContentId.FromHash(hash) System.Func, BlobContentId>( convert ) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 42528dd388..d54373c554 100755 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -2347,6 +2347,7 @@ type TcConfigBuilder = /// and from which we can read the metadata. Only used when metadataOnly=true. mutable tryGetMetadataSnapshot : ILReaderTryGetMetadataSnapshot + mutable internalTestSpanStackReferring : bool } static member Initial = @@ -2483,6 +2484,7 @@ type TcConfigBuilder = copyFSharpCore = CopyFSharpCoreFlag.No shadowCopyReferences = false tryGetMetadataSnapshot = (fun _ -> None) + internalTestSpanStackReferring = false } static member CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir, reduceMemoryUsage, implicitIncludeDir, @@ -2943,6 +2945,7 @@ type TcConfig private (data : TcConfigBuilder, validate:bool) = member x.copyFSharpCore = data.copyFSharpCore member x.shadowCopyReferences = data.shadowCopyReferences member x.tryGetMetadataSnapshot = data.tryGetMetadataSnapshot + member x.internalTestSpanStackReferring = data.internalTestSpanStackReferring static member Create(builder, validate) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter TcConfig(builder, validate) @@ -5431,7 +5434,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig:TcConfig, tcImports:Tc // Typecheck the signature file let! (tcEnv, sigFileType, createsGeneratedProvidedTypes) = - TypeCheckOneSigFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcState.tcsTcSigEnv file + TypeCheckOneSigFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink, tcConfig.internalTestSpanStackReferring) tcState.tcsTcSigEnv file let rootSigs = Zmap.add qualNameOfFile sigFileType tcState.tcsRootSigs @@ -5468,7 +5471,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig:TcConfig, tcImports:Tc // Typecheck the implementation file let! topAttrs, implFile, _implFileHiddenType, tcEnvAtEnd, createsGeneratedProvidedTypes = - TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcImplEnv rootSigOpt file + TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink, tcConfig.internalTestSpanStackReferring) tcImplEnv rootSigOpt file let hadSig = rootSigOpt.IsSome let implFileSigType = SigTypeOfImplFile implFile diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index b7ceb11c41..eb371fa592 100755 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -363,6 +363,9 @@ type TcConfigBuilder = /// A function to call to try to get an object that acts as a snapshot of the metadata section of a .NET binary, /// and from which we can read the metadata. Only used when metadataOnly=true. mutable tryGetMetadataSnapshot : ILReaderTryGetMetadataSnapshot + + /// if true - 'let mutable x = Span.Empty', the value 'x' is a stack referring span. Used for internal testing purposes only until we get true stack spans. + mutable internalTestSpanStackReferring : bool } static member Initial: TcConfigBuilder diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index d660eb712d..6ae18644de 100755 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -832,6 +832,7 @@ let advancedFlagsFsc tcConfigB = let testFlag tcConfigB = CompilerOption("test", tagString, OptionString (fun s -> match s with + | "StackSpan" -> tcConfigB.internalTestSpanStackReferring <- true | "ErrorRanges" -> tcConfigB.errorStyle <- ErrorStyle.TestErrors | "MemberBodyRanges" -> PostTypeCheckSemanticChecks.testFlagMemberBody := true | "Tracking" -> Lib.tracking := true (* general purpose on/off diagnostics flag *) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 466bc3d6d6..4997c4ba59 100755 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -426,8 +426,6 @@ let PreferUnifyTypar (v1:Typar) (v2:Typar) = | true, false -> false | _ -> true - - /// Reorder a list of (variable, exponent) pairs so that a variable that is Preferred /// is at the head of the list, if possible let FindPreferredTypar vs = @@ -479,12 +477,12 @@ and SolveTypStaticReq (csenv:ConstraintSolverEnv) trace req ty = | Some tpr -> SolveTypStaticReqTypar csenv trace req tpr | None -> CompleteD -let rec TransactDynamicReq (trace:OptionalTrace) (tpr:Typar) req = +let TransactDynamicReq (trace:OptionalTrace) (tpr:Typar) req = let orig = tpr.DynamicReq trace.Exec (fun () -> tpr.SetDynamicReq req) (fun () -> tpr.SetDynamicReq orig) CompleteD -and SolveTypDynamicReq (csenv:ConstraintSolverEnv) trace req ty = +let SolveTypDynamicReq (csenv:ConstraintSolverEnv) trace req ty = match req with | TyparDynamicReq.No -> CompleteD | TyparDynamicReq.Yes -> @@ -493,6 +491,19 @@ and SolveTypDynamicReq (csenv:ConstraintSolverEnv) trace req ty = TransactDynamicReq trace tpr TyparDynamicReq.Yes | _ -> CompleteD +let TransactIsCompatFlex (trace:OptionalTrace) (tpr:Typar) req = + let orig = tpr.IsCompatFlex + trace.Exec (fun () -> tpr.SetIsCompatFlex req) (fun () -> tpr.SetIsCompatFlex orig) + CompleteD + +let SolveTypIsCompatFlex (csenv:ConstraintSolverEnv) trace req ty = + if req then + match tryAnyParTy csenv.g ty with + | Some tpr when not tpr.IsCompatFlex -> TransactIsCompatFlex trace tpr req + | _ -> CompleteD + else + CompleteD + let SubstMeasureWarnIfRigid (csenv:ConstraintSolverEnv) trace (v:Typar) ms = if v.Rigidity.WarnIfUnified && not (isAnyParTy csenv.g (TType_measure ms)) then // NOTE: we grab the name eagerly to make sure the type variable prints as a type variable @@ -725,21 +736,23 @@ let rec SolveTyparEqualsType (csenv:ConstraintSolverEnv) ndeep m2 (trace:Optiona CompleteD) ++ (fun _ -> // Re-solve the other constraints associated with this type variable - solveTypMeetsTyparConstraints csenv ndeep m2 trace ty (r.DynamicReq, r.StaticReq, r.Constraints))) + solveTypMeetsTyparConstraints csenv ndeep m2 trace ty r)) | _ -> failwith "SolveTyparEqualsType") -/// Given a type 'ty' and a set of constraints on that type, solve those constraints. -and solveTypMeetsTyparConstraints (csenv:ConstraintSolverEnv) ndeep m2 trace ty (dreq, sreq, cs) = +/// Apply the constraints on 'typar' to the type 'ty' +and solveTypMeetsTyparConstraints (csenv:ConstraintSolverEnv) ndeep m2 trace ty (r: Typar) = let g = csenv.g + // Propagate compat flex requirements from 'tp' to 'ty' + SolveTypIsCompatFlex csenv trace r.IsCompatFlex ty ++ (fun () -> // Propagate dynamic requirements from 'tp' to 'ty' - SolveTypDynamicReq csenv trace dreq ty ++ (fun () -> + SolveTypDynamicReq csenv trace r.DynamicReq ty ++ (fun () -> // Propagate static requirements from 'tp' to 'ty' - SolveTypStaticReq csenv trace sreq ty ++ (fun () -> + SolveTypStaticReq csenv trace r.StaticReq ty ++ (fun () -> // Solve constraints on 'tp' w.r.t. 'ty' - cs |> IterateD (function + r.Constraints |> IterateD (function | TyparConstraint.DefaultsTo (priority, dty, m) -> if typeEquiv g ty dty then CompleteD @@ -762,7 +775,7 @@ and solveTypMeetsTyparConstraints (csenv:ConstraintSolverEnv) ndeep m2 trace ty | TyparConstraint.CoercesTo(ty2, m2) -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m2 trace None ty2 ty | TyparConstraint.MayResolveMember(traitInfo, m2) -> SolveMemberConstraint csenv false false ndeep m2 trace traitInfo ++ (fun _ -> CompleteD) - ))) + )))) /// Add the constraint "ty1 = ty2" to the constraint problem. diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 76a75e7555..8293a709e5 100755 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -17,12 +17,12 @@ undefinedNameTypeParameter,"The type parameter %s is not defined." undefinedNamePatternDiscriminator,"The pattern discriminator '%s' is not defined." replaceWithSuggestion,"Replace with '%s'" addIndexerDot,"Add . for indexer access." -listElementHasWrongType,"All elements of a list constructor expression must have the same type. This expression was expected to have type '%s', but here has type '%s'." -arrayElementHasWrongType,"All elements of an array constructor expression must have the same type. This expression was expected to have type '%s', but here has type '%s'." -missingElseBranch,"The 'if' expression is missing an 'else' branch. The 'then' branch has type '%s'. Because 'if' is an expression, and not a statement, add an 'else' branch which returns a value of the same type." +listElementHasWrongType,"All elements of a list must be of the same type as the first element, which here is '%s'. This element has type '%s'." +arrayElementHasWrongType,"All elements of an array must be of the same type as the first element, which here is '%s'. This element has type '%s'." +missingElseBranch,"This 'if' expression is missing an 'else' branch. Because 'if' is an expression, and not a statement, add an 'else' branch which also returns a value of type '%s'." ifExpression,"The 'if' expression needs to have type '%s' to satisfy context type requirements. It currently has type '%s'." -elseBranchHasWrongType,"All branches of an 'if' expression must have the same type. This expression was expected to have type '%s', but here has type '%s'." -followingPatternMatchClauseHasWrongType,"All branches of a pattern match expression must return values of the same type. The first branch returned a value of type '%s', but this branch returned a value of type '%s'." +elseBranchHasWrongType,"All branches of an 'if' expression must return values of the same type as the first branch, which here is '%s'. This branch returns a value of type '%s'." +followingPatternMatchClauseHasWrongType,"All branches of a pattern match expression must return values of the same type as the first branch, which here is '%s'. This branch returns a value of type '%s'." patternMatchGuardIsNotBool,"A pattern match guard must be of type 'bool', but this 'when' expression is of type '%s'." commaInsteadOfSemicolonInRecord,"A ';' is used to separate field values in records. Consider replacing ',' with ';'." derefInsteadOfNot,"The '!' operator is used to dereference a ref cell. Consider using 'not expr' here." @@ -1430,9 +1430,13 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl 3225,readOnlyAttributeOnStructWithMutableField,"A ReadOnly attribute has been applied to a struct type with a mutable field." 3226,tcByrefReturnImplicitlyDereferenced,"A byref pointer returned by a function or method is implicitly dereferenced as of F# 4.5. To acquire the return value as a pointer, use the address-of operator, e.g. '&f(x)' or '&obj.Method(arg1, arg2)'." 3227,tcByRefLikeNotStruct,"A type annotated with IsByRefLike must also be a struct. Consider adding the [] attribute to the type." -3228,chkNoByrefReturnOfLocal,"The address of the variable '%s' or a related expression cannot be used at this point. The address may not be passed to a call that returns an address. This is to ensure the address of the local value does not escape its scope." -3229,chkNoReturnOfLimitedSpan,"The IsByRefLike expression cannot be returned from this function or method, because it is composed using elements that may escape their scope." +3228,chkNoByrefAddressOfValueFromExpression,"The address of a value returned from the expression cannot be used at this point. This is to ensure the address of the local value does not escape its scope." +3229,chkNoReturnOfLimitedSpan,"The Span or IsByRefLike expression cannot be returned from this function or method, because it is composed using elements that may escape their scope." 3230,chkNoWriteToLimitedSpan,"This value can't be assigned because the target '%s' may refer to non-stack-local memory, while the expression being assigned is assessed to potentially refer to stack-local memory. This is to help prevent pointers to stack-bound memory escaping their scope." 3231,tastValueMustBeLocal,"A value defined in a module must be mutable in order to take its address, e.g. 'let mutable x = ...'" 3232,tcIsReadOnlyNotStruct,"A type annotated with IsReadOnly must also be a struct. Consider adding the [] attribute to the type." 3234,chkStructsMayNotReturnAddressesOfContents,"Struct members cannot return the address of fields of the struct by reference" +3235,chkNoByrefLikeFunctionCall,"The function or method call cannot be used at this point, because one argument that is a byref of a non-stack-local Span or IsByRefLike type is used with another argument that is a stack-local Span or IsByRefLike type. This is to ensure the address of the local value does not escape its scope." +3236,chkNoSpanLikeVariable,"The Span or IsByRefLike variable '%s' cannot be used at this point. This is to ensure the address of the local value does not escape its scope." +3237,chkNoSpanLikeValueFromExpression,"A Span or IsByRefLike value returned from the expression cannot be used at ths point. This is to ensure the address of the local value does not escape its scope." +3238,tastCantTakeAddressOfExpression,"Cannot take the address of the value returned from the expression. Assign the returned value to a let-bound value before taking the address." diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 23c4af9526..496f4531e5 100755 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -3361,14 +3361,19 @@ and CommitCallSequel cenv eenv m cloc cgbuf mustGenerateUnitAfterCall sequel = else GenSequel cenv cloc cgbuf sequel +and MakeNotSupportedExnExpr cenv eenv (argExpr, m) = + let ety = mkAppTy (cenv.g.FindSysTyconRef ["System"] "NotSupportedException") [] + let ilty = GenType cenv.amap m eenv.tyenv ety + let mref = mkILCtorMethSpecForTy(ilty, [cenv.g.ilg.typ_String]).MethodRef + Expr.Op(TOp.ILCall(false,false,false,true,NormalValUse,false,false,mref,[],[],[ety]),[],[argExpr],m) + and GenTraitCall cenv cgbuf eenv (traitInfo, argExprs, m) expr sequel = let minfoOpt = CommitOperationResult (ConstraintSolver.CodegenWitnessThatTypeSupportsTraitConstraint cenv.TcVal cenv.g cenv.amap m traitInfo argExprs) match minfoOpt with | None -> - let replacementExpr = - mkThrow m (tyOfExpr cenv.g expr) - (mkExnExpr(cenv.g.FindSysTyconRef ["System"] "NotSupportedException", - [ mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(traitInfo.MemberName))],m)) + let exnArg = mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(traitInfo.MemberName)) + let exnExpr = MakeNotSupportedExnExpr cenv eenv (exnArg, m) + let replacementExpr = mkThrow m (tyOfExpr cenv.g expr) exnExpr GenExpr cenv cgbuf eenv SPSuppress replacementExpr sequel | Some expr -> let expr = cenv.optimizeDuringCodeGen expr @@ -5218,9 +5223,9 @@ and GenMethodForBinding // However still generate the code for reflection etc. let bodyExpr = if HasFSharpAttribute cenv.g cenv.g.attrib_NoDynamicInvocationAttribute v.Attribs then - mkThrow m returnTy - (mkExnExpr(cenv.g.FindSysTyconRef ["System"] "NotSupportedException", - [ mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(v.CompiledName))],m)) + let exnArg = mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(v.CompiledName)) + let exnExpr = MakeNotSupportedExnExpr cenv eenv (exnArg, m) + mkThrow m returnTy exnExpr else body diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 085936494a..d51bbe953c 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -134,10 +134,14 @@ let AdjustCalledArgType (infoReader:InfoReader) isConstraint (calledArg: CalledA // If the called method argument is an inref type, then the caller may provide a byref or value if isInByrefTy g calledArgTy then +#if IMPLICIT_ADDRESS_OF if isByrefTy g callerArgTy then calledArgTy else destByrefTy g calledArgTy +#else + calledArgTy +#endif // If the called method argument is a (non inref) byref type, then the caller may provide a byref or ref. elif isByrefTy g calledArgTy then diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 6dc2e35f23..cf4d50c4a2 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2909,7 +2909,8 @@ let rec ResolveTypeLongIdentPrim sink (ncenv:NameResolver) occurence first fully | OpenQualified -> match LookupTypeNameInEnvHaveArity fullyQualified id.idText staticResInfo.NumStaticArgs nenv with | Some tcref when IsEntityAccessible ncenv.amap m2 ad tcref -> - OneResult (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad ResolutionInfo.Empty genOk 1 m2 tcref id2 rest2) + let resInfo = ResolutionInfo.Empty.AddEntity(id.idRange, tcref) + OneResult (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk 1 m2 tcref id2 rest2) | _ -> NoResultsOrUsefulErrors diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index f096431224..ca5fd8c674 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -1988,6 +1988,7 @@ let isGeneratedExceptionField pos f = TastDefinitionPrinting.isGeneratedExce let stringOfTyparConstraint denv tpc = stringOfTyparConstraints denv [tpc] let stringOfTy denv x = x |> PrintTypes.layoutType denv |> showL let prettyLayoutOfType denv x = x |> PrintTypes.prettyLayoutOfType denv +let prettyLayoutOfTypeNoCx denv x = x |> PrintTypes.prettyLayoutOfTypeNoConstraints denv let prettyStringOfTy denv x = x |> PrintTypes.prettyLayoutOfType denv |> showL let prettyStringOfTyNoCx denv x = x |> PrintTypes.prettyLayoutOfTypeNoConstraints denv |> showL let stringOfRecdField denv x = x |> TastDefinitionPrinting.layoutRecdField false denv |> showL diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 0705c5c4fb..3ffbc94b04 100755 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -4,6 +4,7 @@ module internal Microsoft.FSharp.Compiler.PatternMatchCompilation open System.Collections.Generic open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.Range @@ -169,6 +170,25 @@ type RefutedSet = let notNullText = "some-non-null-value" let otherSubtypeText = "some-other-subtype" +/// Create a TAST const value from an IL-initialized field read from .NET metadata +// (Originally moved from TcFieldInit in TypeChecker.fs -- feel free to move this somewhere more appropriate) +let ilFieldToTastConst lit = + match lit with + | ILFieldInit.String s -> Const.String s + | ILFieldInit.Null -> Const.Zero + | ILFieldInit.Bool b -> Const.Bool b + | ILFieldInit.Char c -> Const.Char (char (int c)) + | ILFieldInit.Int8 x -> Const.SByte x + | ILFieldInit.Int16 x -> Const.Int16 x + | ILFieldInit.Int32 x -> Const.Int32 x + | ILFieldInit.Int64 x -> Const.Int64 x + | ILFieldInit.UInt8 x -> Const.Byte x + | ILFieldInit.UInt16 x -> Const.UInt16 x + | ILFieldInit.UInt32 x -> Const.UInt32 x + | ILFieldInit.UInt64 x -> Const.UInt64 x + | ILFieldInit.Single f -> Const.Single f + | ILFieldInit.Double f -> Const.Double f + exception CannotRefute let RefuteDiscrimSet g m path discrims = let mkUnknown ty = snd(mkCompGenLocal m "_" ty) @@ -238,16 +258,28 @@ let RefuteDiscrimSet g m path discrims = | Some c -> match tryDestAppTy g ty with | Some tcref when tcref.IsEnumTycon -> - // search for an enum value that pattern match (consts) does not contain - let nonCoveredEnumValues = - tcref.AllFieldsArray |> Array.tryFind (fun f -> - match f.rfield_const with - | None -> false - | Some fieldValue -> (not (consts.Contains fieldValue)) && f.rfield_static) + // We must distinguish between F#-defined enums and other .NET enums, as they are represented differently in the TAST + let enumValues = + if tcref.IsILEnumTycon then + let (TILObjectReprData(_, _, tdef)) = tcref.ILTyconInfo + tdef.Fields.AsList + |> Seq.choose (fun ilField -> + if ilField.IsStatic then + ilField.LiteralValue |> Option.map (fun ilValue -> + ilField.Name, ilFieldToTastConst ilValue) + else None) + else + tcref.AllFieldsArray |> Seq.choose (fun fsField -> + match fsField.rfield_const, fsField.rfield_static with + | Some fsFieldValue, true -> Some (fsField.rfield_id.idText, fsFieldValue) + | _ -> None) + + let nonCoveredEnumValues = Seq.tryFind (fun (_, fldValue) -> not (consts.Contains fldValue)) enumValues + match nonCoveredEnumValues with | None -> Expr.Const(c,m,ty), true - | Some f -> - let v = RecdFieldRef.RFRef(tcref, f.rfield_id.idText) + | Some (fldName, _) -> + let v = RecdFieldRef.RFRef(tcref, fldName) Expr.Op(TOp.ValFieldGet v, [ty], [], m), false | _ -> Expr.Const(c,m,ty), false diff --git a/src/fsharp/PatternMatchCompilation.fsi b/src/fsharp/PatternMatchCompilation.fsi index 160396caf0..348f37ae94 100755 --- a/src/fsharp/PatternMatchCompilation.fsi +++ b/src/fsharp/PatternMatchCompilation.fsi @@ -2,6 +2,7 @@ module internal Microsoft.FSharp.Compiler.PatternMatchCompilation +open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops @@ -42,6 +43,8 @@ and PatternValBinding = and TypedMatchClause = | TClause of Pattern * Expr option * DecisionTreeTarget * range +val ilFieldToTastConst : ILFieldInit -> Tast.Const + /// Compile a pattern into a decision tree and a set of targets. val internal CompilePattern : TcGlobals -> diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index db5205e896..761d5395e8 100755 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -103,7 +103,10 @@ type env = reflect : bool /// Are we in an extern declaration? - external : bool } + external : bool + + /// Current return scope of the expr. + returnScope : int } let BindTypar env (tp:Typar) = { env with @@ -125,9 +128,75 @@ let BindTypars g env (tps:Typar list) = let BindArgVals env (vs: Val list) = { env with argVals = ValMap.OfList (List.map (fun v -> (v,())) vs) } +/// Limit flags represent a type(s) returned from checking an expression(s) that is interesting to impose rules on. +[] +type LimitFlags = + | None = 0b00000 + | ByRef = 0b00001 + | ByRefOfSpanLike = 0b00011 + | ByRefOfStackReferringSpanLike = 0b00101 + | SpanLike = 0b01000 + | StackReferringSpanLike = 0b10000 + +[] +type Limit = + { + scope: int + flags: LimitFlags + } + + member this.IsLocal = this.scope >= 1 + +/// Check if the limit has the target limit. +let inline HasLimitFlag targetLimit (limit: Limit) = + limit.flags &&& targetLimit = targetLimit + +let NoLimit = { scope = 0; flags = LimitFlags.None } + +// Combining two limits will result in both limit flags merged. +// If none of the limits are limited by a by-ref or a stack referring span-like +// the scope will be 0. +let CombineTwoLimits limit1 limit2 = + let isByRef1 = HasLimitFlag LimitFlags.ByRef limit1 + let isByRef2 = HasLimitFlag LimitFlags.ByRef limit2 + let isStackSpan1 = HasLimitFlag LimitFlags.StackReferringSpanLike limit1 + let isStackSpan2 = HasLimitFlag LimitFlags.StackReferringSpanLike limit2 + let isLimited1 = isByRef1 || isStackSpan1 + let isLimited2 = isByRef2 || isStackSpan2 + + // A limit that has a stack referring span-like but not a by-ref, + // we force the scope to 1. This is to handle call sites + // that return a by-ref and have stack referring span-likes as arguments. + // This is to ensure we can only prevent out of scope at the method level rather than visibility. + let limit1 = + if isStackSpan1 && not isByRef1 then + { limit1 with scope = 1 } + else + limit1 + + let limit2 = + if isStackSpan2 && not isByRef2 then + { limit2 with scope = 1 } + else + limit2 + + match isLimited1, isLimited2 with + | false, false -> + { scope = 0; flags = limit1.flags ||| limit2.flags } + | true, true -> + { scope = Math.Max(limit1.scope, limit2.scope); flags = limit1.flags ||| limit2.flags } + | true, false -> + { limit1 with flags = limit1.flags ||| limit2.flags } + | false, true -> + { limit2 with flags = limit1.flags ||| limit2.flags } + +let CombineLimits limits = + (NoLimit, limits) + ||> List.fold CombineTwoLimits + type cenv = - { boundVals: Dictionary // really a hash set - limitVals: Dictionary // really a hash set + { boundVals: Dictionary // really a hash set + limitVals: Dictionary mutable potentialUnboundUsesOfVals: StampMap g: TcGlobals amap: Import.ImportMap @@ -138,12 +207,75 @@ type cenv = viewCcu : CcuThunk reportErrors: bool isLastCompiland : bool*bool + isInternalTestSpanStackReferring: bool // outputs mutable usesQuotations : bool mutable entryPointGiven:bool } -let LimitVal cenv (v:Val) = - cenv.limitVals.[v.Stamp] <- 1 +/// Check if the value is an argument of a function +let IsValArgument env (v: Val) = + env.argVals.ContainsVal(v) + +/// Check if the value is a local, not an argument of a function. +let IsValLocal env (v: Val) = + v.ValReprInfo.IsNone && not (IsValArgument env v) + +/// Get the limit of the val. +let GetLimitVal cenv env m (v: Val) = + let limit = + match cenv.limitVals.TryGetValue(v.Stamp) with + | true, limit -> limit + | _ -> + if IsValLocal env v then + { scope = 1; flags = LimitFlags.None } + else + NoLimit + + if isSpanLikeTy cenv.g m v.Type then + // The value is a limited Span or might have become one through mutation + let isMutable = v.IsMutable && cenv.isInternalTestSpanStackReferring + let isLimited = HasLimitFlag LimitFlags.StackReferringSpanLike limit + + if isMutable || isLimited then + { limit with flags = LimitFlags.StackReferringSpanLike } + else + { limit with flags = LimitFlags.SpanLike } + + elif isByrefTy cenv.g v.Type then + let isByRefOfSpanLike = isSpanLikeTy cenv.g m (destByrefTy cenv.g v.Type) + + if isByRefOfSpanLike then + if HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limit then + { limit with flags = LimitFlags.ByRefOfStackReferringSpanLike } + else + { limit with flags = LimitFlags.ByRefOfSpanLike } + else + { limit with flags = LimitFlags.ByRef } + + else + { limit with flags = LimitFlags.None } + +/// Get the limit of the val by reference. +let GetLimitValByRef cenv env m v = + let limit = GetLimitVal cenv env m v + + let scope = + // Getting the address of an argument will always be a scope of 1. + if IsValArgument env v then 1 + else limit.scope + + let flags = + if HasLimitFlag LimitFlags.StackReferringSpanLike limit then + LimitFlags.ByRefOfStackReferringSpanLike + elif HasLimitFlag LimitFlags.SpanLike limit then + LimitFlags.ByRefOfSpanLike + else + LimitFlags.ByRef + + { scope = scope; flags = flags } + +let LimitVal cenv (v:Val) limit = + cenv.limitVals.[v.Stamp] <- limit let BindVal cenv env (v:Val) = //printfn "binding %s..." v.DisplayName @@ -345,11 +477,8 @@ type PermitByRefType = /// Don't permit any byref or byref-like types | None - /// Permit only an outermost Span or IsByRefLike type - | OuterSpanLike - - /// Permit only an outermost Span, IsByRefLike, inref, outref or byref type - | OuterByRefLike + /// Permit only a Span or IsByRefLike type + | SpanLike /// Permit all byref and byref-like types | All @@ -367,49 +496,59 @@ type PermitByRefExpr = /// Context allows for byref typed expr, but the byref must be returnable | YesReturnable + /// Context allows for byref typed expr, but the byref must be returnable and a non-local + | YesReturnableNonLocal + /// General (address-of expr and byref values not allowed) | No member context.Disallow = match context with | PermitByRefExpr.Yes - | PermitByRefExpr.YesReturnable -> false + | PermitByRefExpr.YesReturnable + | PermitByRefExpr.YesReturnableNonLocal -> false | _ -> true member context.PermitOnlyReturnable = match context with - | PermitByRefExpr.YesReturnable -> true + | PermitByRefExpr.YesReturnable + | PermitByRefExpr.YesReturnableNonLocal -> true + | _ -> false + + member context.PermitOnlyReturnableNonLocal = + match context with + | PermitByRefExpr.YesReturnableNonLocal -> true | _ -> false -let ignoreLimit (_limit: bool) = () +let inline IsLimitEscapingScope env (context: PermitByRefExpr) limit = + (limit.scope >= env.returnScope || (limit.IsLocal && context.PermitOnlyReturnableNonLocal)) -let mkArgsPermit isByRefReturnCall n = - if n=1 then - if isByRefReturnCall then PermitByRefExpr.YesReturnable else PermitByRefExpr.Yes +let mkArgsPermit n = + if n=1 then PermitByRefExpr.Yes else PermitByRefExpr.YesTupleOfArgs n /// Work out what byref-values are allowed at input positions to named F# functions or members -let mkArgsForAppliedVal isBaseCall isByRefReturnCall (vref:ValRef) argsl = +let mkArgsForAppliedVal isBaseCall (vref:ValRef) argsl = match vref.ValReprInfo with | Some topValInfo -> let argArities = topValInfo.AritiesOfArgs let argArities = if isBaseCall && argArities.Length >= 1 then List.tail argArities else argArities // Check for partial applications: arguments to partial applciations don't get to use byrefs if List.length argsl >= argArities.Length then - List.map (mkArgsPermit isByRefReturnCall) argArities + List.map mkArgsPermit argArities else [] | None -> [] /// Work out what byref-values are allowed at input positions to functions -let rec mkArgsForAppliedExpr isBaseCall isByRefReturnCall argsl x = +let rec mkArgsForAppliedExpr isBaseCall argsl x = match stripExpr x with // recognise val - | Expr.Val (vref,_,_) -> mkArgsForAppliedVal isBaseCall isByRefReturnCall vref argsl + | Expr.Val (vref,_,_) -> mkArgsForAppliedVal isBaseCall vref argsl // step through instantiations - | Expr.App(f,_fty,_tyargs,[],_) -> mkArgsForAppliedExpr isBaseCall isByRefReturnCall argsl f + | Expr.App(f,_fty,_tyargs,[],_) -> mkArgsForAppliedExpr isBaseCall argsl f // step through subsumption coercions - | Expr.Op(TOp.Coerce,_,[f],_) -> mkArgsForAppliedExpr isBaseCall isByRefReturnCall argsl f + | Expr.Op(TOp.Coerce,_,[f],_) -> mkArgsForAppliedExpr isBaseCall argsl f | _ -> [] /// Check types occurring in the TAST. @@ -422,14 +561,12 @@ let CheckType permitByRefLike (cenv:cenv) env m ty = else errorR (Error(FSComp.SR.checkNotSufficientlyGenericBecauseOfScope(tp.DisplayName),m)) - let visitTyconRef isInner tcref = + let visitTyconRef _isInner tcref = match permitByRefLike with | PermitByRefType.None when isByrefLikeTyconRef cenv.g m tcref -> errorR(Error(FSComp.SR.chkErrorUseOfByref(), m)) - | PermitByRefType.OuterSpanLike when isInner && isByrefTyconRef cenv.g tcref -> - errorR(Error(FSComp.SR.chkErrorUseOfByref(), m)) - | PermitByRefType.OuterByRefLike when isInner && isByrefLikeTyconRef cenv.g m tcref -> + | PermitByRefType.SpanLike when isByrefTyconRef cenv.g tcref -> errorR(Error(FSComp.SR.chkErrorUseOfByref(), m)) | _ -> () @@ -463,11 +600,8 @@ let CheckType permitByRefLike (cenv:cenv) env m ty = /// The additional byref checks are to catch "byref instantiations" - one place were byref are not permitted. let CheckTypeNoByrefs (cenv:cenv) env m ty = CheckType PermitByRefType.None cenv env m ty -/// Check types occurring in TAST but allow an outer byref. -let CheckTypePermitOuterByRefLike (cenv:cenv) env m ty = CheckType PermitByRefType.OuterByRefLike cenv env m ty - -/// Check types occurring in TAST but allow an outer Span or similar -let CheckTypePermitOuterSpanLike (cenv:cenv) env m ty = CheckType PermitByRefType.OuterSpanLike cenv env m ty +/// Check types occurring in TAST but allow a Span or similar +let CheckTypePermitSpanLike (cenv:cenv) env m ty = CheckType PermitByRefType.SpanLike cenv env m ty /// Check types occurring in TAST but allow all byrefs. Only used on internally-generated types let CheckTypePermitAllByrefs (cenv:cenv) env m ty = CheckType PermitByRefType.All cenv env m ty @@ -514,7 +648,7 @@ let CheckMultipleInterfaceInstantiations cenv interfaces m = /// Check an expression, where the expression is in a position where byrefs can be generated let rec CheckExprNoByrefs cenv env expr = - CheckExpr cenv env expr PermitByRefExpr.No |> ignoreLimit + CheckExpr cenv env expr PermitByRefExpr.No |> ignore /// Check a value and CheckValRef (cenv:cenv) (env:env) v m (context: PermitByRefExpr) = @@ -531,25 +665,12 @@ and CheckValRef (cenv:cenv) (env:env) v m (context: PermitByRefExpr) = CheckTypePermitAllByrefs cenv env m v.Type // the byref checks are done at the actual binding of the value -and IsLimitedType g m ty = - isByrefLikeTy g m ty && - not (isByrefTy g ty) - -and IsLimited cenv env m (vref: ValRef) = - IsLimitedType cenv.g m vref.Type && - // The value is a arg/local.... - vref.ValReprInfo.IsNone && - // The value is a limited Span or might have become one through mutation - let isMutableLocal = not (env.argVals.ContainsVal(vref.Deref)) && vref.IsMutable - let isLimitedLocal = cenv.limitVals.ContainsKey(vref.Stamp) - isMutableLocal || isLimitedLocal - /// Check a use of a value and CheckValUse (cenv: cenv) (env: env) (vref: ValRef, vFlags, m) (context: PermitByRefExpr) = let g = cenv.g - // Is this a Span-typed value that is limited (i.e. can't be returned) - let limit = IsLimited cenv env m vref + + let limit = GetLimitVal cenv env m vref.Deref if cenv.reportErrors then @@ -564,16 +685,23 @@ and CheckValUse (cenv: cenv) (env: env) (vref: ValRef, vFlags, m) (context: Perm if isCallOfConstructorOfAbstractType then errorR(Error(FSComp.SR.tcAbstractTypeCannotBeInstantiated(),m)) - let isReturnExprBuiltUsingByRefLocal = + // This is used to handle this case: + // let x = 1 + // let y = &x + // &y + let isReturnExprBuiltUsingStackReferringByRefLike = context.PermitOnlyReturnable && - isByrefTy g vref.Type && - // The value is a local.... - vref.ValReprInfo.IsNone && - // The value is not an argument.... - not (env.argVals.ContainsVal(vref.Deref)) - - if isReturnExprBuiltUsingByRefLocal then - errorR(Error(FSComp.SR.chkNoByrefReturnOfLocal(vref.DisplayName), m)) + ((HasLimitFlag LimitFlags.ByRef limit && IsLimitEscapingScope env context limit) || + HasLimitFlag LimitFlags.StackReferringSpanLike limit) + + if isReturnExprBuiltUsingStackReferringByRefLike then + let isSpanLike = isSpanLikeTy g m vref.Type + let isCompGen = vref.IsCompilerGenerated + match isSpanLike, isCompGen with + | true, true -> errorR(Error(FSComp.SR.chkNoSpanLikeValueFromExpression(), m)) + | true, false -> errorR(Error(FSComp.SR.chkNoSpanLikeVariable(vref.DisplayName), m)) + | false, true -> errorR(Error(FSComp.SR.chkNoByrefAddressOfValueFromExpression(), m)) + | false, false -> errorR(Error(FSComp.SR.chkNoByrefAddressOfLocal(vref.DisplayName), m)) let isReturnOfStructThis = context.PermitOnlyReturnable && @@ -584,6 +712,7 @@ and CheckValUse (cenv: cenv) (env: env) (vref: ValRef, vFlags, m) (context: Perm errorR(Error(FSComp.SR.chkStructsMayNotReturnAddressesOfContents(), m)) CheckValRef cenv env vref m context + limit /// Check an expression, given information about the position of the expression @@ -627,8 +756,95 @@ and CheckForOverAppliedExceptionRaisingPrimitive (cenv:cenv) expr = | _ -> () | _ -> () +and CheckCallLimitArgs cenv env m returnTy limitArgs (context: PermitByRefExpr) = + let isReturnByref = isByrefTy cenv.g returnTy + let isReturnSpanLike = isSpanLikeTy cenv.g m returnTy + + // If return is a byref, and being used as a return, then a single argument cannot be a local-byref or a stack referring span-like. + let isReturnLimitedByRef = + isReturnByref && + (HasLimitFlag LimitFlags.ByRef limitArgs || + HasLimitFlag LimitFlags.StackReferringSpanLike limitArgs) + + // If return is a byref, and being used as a return, then a single argument cannot be a stack referring span-like or a local-byref of a stack referring span-like. + let isReturnLimitedSpanLike = + isReturnSpanLike && + (HasLimitFlag LimitFlags.StackReferringSpanLike limitArgs || + HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limitArgs) + + if cenv.reportErrors then + if context.PermitOnlyReturnable && ((isReturnLimitedByRef && IsLimitEscapingScope env context limitArgs) || isReturnLimitedSpanLike) then + if isReturnLimitedSpanLike then + errorR(Error(FSComp.SR.chkNoSpanLikeValueFromExpression(), m)) + else + errorR(Error(FSComp.SR.chkNoByrefAddressOfValueFromExpression(), m)) + + // You cannot call a function that takes a byref of a span-like (not stack referring) and + // either a stack referring spanlike or a local-byref of a stack referring span-like. + let isCallLimited = + HasLimitFlag LimitFlags.ByRefOfSpanLike limitArgs && + (HasLimitFlag LimitFlags.StackReferringSpanLike limitArgs || + HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limitArgs) + + if isCallLimited then + errorR(Error(FSComp.SR.chkNoByrefLikeFunctionCall(), m)) + + if isReturnLimitedByRef then + if isSpanLikeTy cenv.g m (destByrefTy cenv.g returnTy) then + let isStackReferring = + HasLimitFlag LimitFlags.StackReferringSpanLike limitArgs || + HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limitArgs + if isStackReferring then + { limitArgs with flags = LimitFlags.ByRefOfStackReferringSpanLike } + else + { limitArgs with flags = LimitFlags.ByRefOfSpanLike } + else + { limitArgs with flags = LimitFlags.ByRef } + + elif isReturnLimitedSpanLike then + { scope = 1; flags = LimitFlags.StackReferringSpanLike } + + elif isReturnByref then + if isSpanLikeTy cenv.g m (destByrefTy cenv.g returnTy) then + { limitArgs with flags = LimitFlags.ByRefOfSpanLike } + else + { limitArgs with flags = LimitFlags.ByRef } + + elif isReturnSpanLike then + { scope = 1; flags = LimitFlags.SpanLike } + + else + { scope = 1; flags = LimitFlags.None } + +/// Check call arguments, including the return argument. +and CheckCall cenv env m returnTy args contexts context = + let limitArgs = CheckExprs cenv env args contexts + CheckCallLimitArgs cenv env m returnTy limitArgs context + +/// Check call arguments, including the return argument. The receiver argument is handled differently. +and CheckCallWithReceiver cenv env m returnTy args contexts context = + match args with + | [] -> failwith "CheckCallWithReceiver: Argument list is empty." + | receiverArg :: args -> + + let receiverContext, contexts = + match contexts with + | [] -> PermitByRefExpr.No, [] + | context :: contexts -> context, contexts + + let receiverLimit = CheckExpr cenv env receiverArg receiverContext + let limitArgs = + let limitArgs = CheckExprs cenv env args contexts + // We do not include the receiver's limit in the limit args unless the receiver is a stack referring span-like. + if HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike receiverLimit then + // Scope is 1 to ensure any by-refs returned can only be prevented for out of scope of the function/method, not visibility. + CombineTwoLimits limitArgs { receiverLimit with scope = 1 } + else + limitArgs + CheckCallLimitArgs cenv env m returnTy limitArgs context + /// Check an expression, given information about the position of the expression -and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : bool = +and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = let g = cenv.g let origExpr = stripExpr origExpr @@ -646,18 +862,25 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : bool = CheckExpr cenv env e2 context // carry context into _;RHS (normal sequencing only) | ThenDoSeq -> CheckExprNoByrefs cenv {env with ctorLimitedZone=false} e2 - false + NoLimit - | Expr.Let (bind,body,_,_) -> - let limit = CheckBinding cenv env false bind - BindVal cenv env bind.Var - if limit then - LimitVal cenv bind.Var + | Expr.Let ((TBind(v,_bindRhs,_) as bind),body,_,_) -> + let isByRef = isByrefTy cenv.g v.Type + + let bindingContext = + if isByRef then + PermitByRefExpr.YesReturnable + else + PermitByRefExpr.Yes + + let limit = CheckBinding cenv { env with returnScope = env.returnScope + 1 } false bindingContext bind + BindVal cenv env v + LimitVal cenv v { limit with scope = if isByRef then limit.scope else env.returnScope } CheckExpr cenv env body context | Expr.Const (_,m,ty) -> - CheckTypePermitOuterByRefLike cenv env m ty - false + CheckTypePermitAllByrefs cenv env m ty + NoLimit | Expr.Val (vref,vFlags,m) -> CheckValUse cenv env (vref, vFlags, m) context @@ -679,7 +902,7 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : bool = errorRecovery e m CheckTypeNoByrefs cenv env m ty - false + NoLimit | Expr.Obj (_,ty,basev,superInitCall,overrides,iimpls,m) -> CheckExprNoByrefs cenv env superInitCall @@ -695,7 +918,7 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : bool = |> List.filter (isInterfaceTy g) CheckMultipleInterfaceInstantiations cenv interfaces m - false + NoLimit // Allow base calls to F# methods | Expr.App((InnerExprPat(ExprValWithPossibleTypeInst(v,vFlags,_,_) as f)),_fty,tyargs,(Expr.Val(baseVal,_,_) :: rest),m) @@ -705,12 +928,12 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : bool = let memberInfo = Option.get v.MemberInfo if memberInfo.MemberFlags.IsDispatchSlot then errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(v.DisplayName),m)) - false + NoLimit else CheckValRef cenv env v m PermitByRefExpr.No CheckValRef cenv env baseVal m PermitByRefExpr.No CheckTypeInstNoByrefs cenv env m tyargs - CheckExprs cenv env rest (mkArgsForAppliedExpr true false rest f) + CheckExprs cenv env rest (mkArgsForAppliedExpr true rest f) // Allow base calls to IL methods | Expr.Op (TOp.ILCall (virt,_,_,_,_,_,_,mref,enclTypeArgs,methTypeArgs,tys),tyargs,(Expr.Val(baseVal,_,_)::rest),m) @@ -742,43 +965,49 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : bool = // Allow 'typeof' calls as a special case, the only accepted use of System.Void! | TypeOfExpr g ty when isVoidTy g ty -> - false + NoLimit // Allow 'typedefof' calls as a special case, the only accepted use of System.Void! | TypeDefOfExpr g ty when isVoidTy g ty -> - false + NoLimit // Allow '%expr' in quotations | Expr.App(Expr.Val(vref,_,_),_,tinst,[arg],m) when isSpliceOperator g vref && env.quote -> CheckTypeInstPermitAllByrefs cenv env m tinst // it's the splice operator, a byref instantiation is allowed CheckExprNoByrefs cenv env arg - false + NoLimit // Check an application | Expr.App(f,_fty,tyargs,argsl,m) -> - CheckTypeInstNoByrefs cenv env m tyargs CheckExprNoByrefs cenv env f - // If return is a byref, and being used as a return, then all arguments must be usable as byref returns - let isByRefReturnCall = context.PermitOnlyReturnable && isByrefTy g (tyOfExpr g expr) + let hasReceiver = + match f with + | Expr.Val(vref, _, _) when vref.IsInstanceMember && not argsl.IsEmpty -> true + | _ -> false - CheckExprs cenv env argsl (mkArgsForAppliedExpr false isByRefReturnCall argsl f) + let returnTy = tyOfExpr g expr + let contexts = mkArgsForAppliedExpr false argsl f + if hasReceiver then + CheckCallWithReceiver cenv env m returnTy argsl contexts context + else + CheckCall cenv env m returnTy argsl contexts context | Expr.Lambda(_,_ctorThisValOpt,_baseValOpt,argvs,_,m,rty) -> let topValInfo = ValReprInfo ([],[argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)],ValReprInfo.unnamedRetVal) let ty = mkMultiLambdaTy m argvs rty in - CheckLambdas false None cenv env false topValInfo false expr m ty + CheckLambdas false None cenv env false topValInfo false expr m ty PermitByRefExpr.Yes | Expr.TyLambda(_,tps,_,m,rty) -> let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps,[],ValReprInfo.unnamedRetVal) let ty = mkForallTyIfNeeded tps rty in - CheckLambdas false None cenv env false topValInfo false expr m ty + CheckLambdas false None cenv env false topValInfo false expr m ty PermitByRefExpr.Yes | Expr.TyChoose(tps,e1,_) -> let env = BindTypars g env tps CheckExprNoByrefs cenv env e1 - false + NoLimit | Expr.Match(_,_,dtree,targets,m,ty) -> CheckTypePermitAllByrefs cenv env m ty // computed byrefs allowed at each branch @@ -789,7 +1018,7 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : bool = BindVals cenv env (valsOfBinds binds) CheckBindings cenv env binds CheckExprNoByrefs cenv env e - false + NoLimit | Expr.StaticOptimization (constraints,e2,e3,m) -> CheckExprNoByrefs cenv env e2 @@ -800,7 +1029,7 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : bool = CheckTypeNoByrefs cenv env m ty2 | TTyconIsStruct(ty1) -> CheckTypeNoByrefs cenv env m ty1) - false + NoLimit | Expr.Link _ -> failwith "Unexpected reclink" @@ -815,9 +1044,7 @@ and CheckMethod cenv env baseValOpt (TObjExprMethod(_,attribs,tps,vs,body,m)) = CheckAttribs cenv env attribs CheckNoReraise cenv None body CheckEscapes cenv true m (match baseValOpt with Some x -> x:: vs | None -> vs) body |> ignore - let limit = CheckExprPermitReturnableByRef cenv env body - if limit then - errorR(Error(FSComp.SR.chkNoReturnOfLimitedSpan(), body.Range)) + CheckExpr cenv { env with returnScope = env.returnScope + 1 } body PermitByRefExpr.YesReturnableNonLocal |> ignore and CheckInterfaceImpls cenv env baseValOpt l = l |> List.iter (CheckInterfaceImpl cenv env baseValOpt) @@ -854,18 +1081,33 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = let limit1 = CheckExpr cenv env e1 context // result of a try/catch can be a byref if in a position where the overall expression is can be a byref // [(* e2; -- don't check filter body - duplicates logic in 'catch' body *) e3] let limit2 = CheckExpr cenv env e3 context // result of a try/catch can be a byref if in a position where the overall expression is can be a byref - limit1 || limit2 + CombineTwoLimits limit1 limit2 - | TOp.ILCall (_,_,_,_,_,_,_,_,enclTypeArgs,methTypeArgs,tys),_,_ -> + | TOp.ILCall (_,_,_,_,_,_,_,methRef,enclTypeArgs,methTypeArgs,tys),_,_ -> CheckTypeInstNoByrefs cenv env m tyargs CheckTypeInstNoByrefs cenv env m enclTypeArgs CheckTypeInstNoByrefs cenv env m methTypeArgs CheckTypeInstPermitAllByrefs cenv env m tys // permit byref returns - // if return is a byref, and being used as a return, then all arguments must be usable as byref returns - match tys with - | [ty] when context.PermitOnlyReturnable && isByrefLikeTy g m ty -> CheckExprsPermitReturnableByRef cenv env args - | _ -> CheckExprsPermitByRefLike cenv env args + let hasReceiver = + (methRef.CallingConv.IsInstance || methRef.CallingConv.IsInstanceExplicit) && + not args.IsEmpty + + let returnTy = tyOfExpr g expr + + let argContexts = List.init args.Length (fun _ -> PermitByRefExpr.Yes) + + match tys with + | [ty] when context.PermitOnlyReturnable && isByrefLikeTy g m ty -> + if hasReceiver then + CheckCallWithReceiver cenv env m returnTy args argContexts context + else + CheckCall cenv env m returnTy args argContexts context + | _ -> + if hasReceiver then + CheckCallWithReceiver cenv env m returnTy args argContexts PermitByRefExpr.Yes + else + CheckCall cenv env m returnTy args argContexts PermitByRefExpr.Yes | TOp.Tuple tupInfo,_,_ when not (evalTupInfoIsStruct tupInfo) -> match context with @@ -881,6 +1123,10 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = CheckExprsNoByRefLike cenv env args | TOp.LValueOp(LAddrOf _,vref),_,_ -> + let limit1 = GetLimitValByRef cenv env m vref.Deref + let limit2 = CheckExprsNoByRefLike cenv env args + let limit = CombineTwoLimits limit1 limit2 + if cenv.reportErrors then if context.Disallow then @@ -888,35 +1134,47 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = let returningAddrOfLocal = context.PermitOnlyReturnable && - // The value is a local.... - vref.ValReprInfo.IsNone && - // The value is not an argument... - not (env.argVals.ContainsVal(vref.Deref)) + HasLimitFlag LimitFlags.ByRef limit && + IsLimitEscapingScope env context limit if returningAddrOfLocal then - errorR(Error(FSComp.SR.chkNoByrefAddressOfLocal(vref.DisplayName), m)) + if vref.IsCompilerGenerated then + errorR(Error(FSComp.SR.chkNoByrefAddressOfValueFromExpression(), m)) + else + errorR(Error(FSComp.SR.chkNoByrefAddressOfLocal(vref.DisplayName), m)) - let limit1 = IsLimited cenv env m vref - let limit2 = CheckExprsNoByRefLike cenv env args - limit1 || limit2 + limit | TOp.LValueOp(LByrefSet,vref),_,[arg] -> - let limit1 = IsLimitedType g m (tyOfExpr g arg) && not (env.argVals.ContainsVal(vref.Deref)) - let limit2 = CheckExprPermitByRefLike cenv env arg - if not limit1 && limit2 then + let limit = GetLimitVal cenv env m vref.Deref + let isVrefLimited = not (HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limit) + let isArgLimited = HasLimitFlag LimitFlags.StackReferringSpanLike (CheckExprPermitByRefLike cenv env arg) + if isVrefLimited && isArgLimited then errorR(Error(FSComp.SR.chkNoWriteToLimitedSpan(vref.DisplayName), m)) - false + NoLimit | TOp.LValueOp(LByrefGet,vref),_,[] -> - let limit1 = isByrefTy g vref.Type && IsLimitedType g m (destByrefTy g vref.Type) && not (env.argVals.ContainsVal(vref.Deref)) - limit1 + let limit = GetLimitVal cenv env m vref.Deref + if HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limit then + + if cenv.reportErrors && context.PermitOnlyReturnable then + if vref.IsCompilerGenerated then + errorR(Error(FSComp.SR.chkNoSpanLikeValueFromExpression(), m)) + else + errorR(Error(FSComp.SR.chkNoSpanLikeVariable(vref.DisplayName), m)) + + { scope = 1; flags = LimitFlags.StackReferringSpanLike } + elif HasLimitFlag LimitFlags.ByRefOfSpanLike limit then + { scope = 1; flags = LimitFlags.SpanLike } + else + { scope = 1; flags = LimitFlags.None } | TOp.LValueOp(LSet _, vref),_,[arg] -> - let limit1 = IsLimited cenv env m vref - let limit2 = CheckExprPermitByRefLike cenv env arg - if not limit1 && limit2 then + let isVrefLimited = not (HasLimitFlag LimitFlags.StackReferringSpanLike (GetLimitVal cenv env m vref.Deref)) + let isArgLimited = HasLimitFlag LimitFlags.StackReferringSpanLike (CheckExprPermitByRefLike cenv env arg) + if isVrefLimited && isArgLimited then errorR(Error(FSComp.SR.chkNoWriteToLimitedSpan(vref.DisplayName), m)) - false + NoLimit | TOp.TupleFieldGet _,_,[arg1] -> CheckTypeInstNoByrefs cenv env m tyargs @@ -928,11 +1186,18 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = // Property getters on mutable structs come through here. CheckExprsPermitByRefLike cenv env [arg1] - | TOp.ValFieldSet _rf,_,[arg1;arg2] -> + | TOp.ValFieldSet rf,_,[arg1;arg2] -> CheckTypeInstNoByrefs cenv env m tyargs // See mkRecdFieldSetViaExprAddr -- byref arg1 when #args=2 // Field setters on mutable structs come through here - CheckExprsPermitByRefLike cenv env [arg1; arg2] + let limit1 = CheckExprPermitByRefLike cenv env arg1 + let limit2 = CheckExprPermitByRefLike cenv env arg2 + + let isLhsLimited = not (HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limit1) + let isRhsLimited = HasLimitFlag LimitFlags.StackReferringSpanLike limit2 + if isLhsLimited && isRhsLimited then + errorR(Error(FSComp.SR.chkNoWriteToLimitedSpan(rf.FieldName), m)) + NoLimit | TOp.Coerce,[tgty;srcty],[x] -> if TypeRelations.TypeDefinitelySubsumesTypeNoCoercion 0 g cenv.amap m tgty srcty then @@ -940,11 +1205,11 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = else CheckTypeInstNoByrefs cenv env m tyargs CheckExprNoByrefs cenv env x - false + NoLimit | TOp.Reraise,[_ty1],[] -> CheckTypeInstNoByrefs cenv env m tyargs - false + NoLimit // Check get of static field | TOp.ValFieldGetAddr (rfref, _readonly),tyargs,[] -> @@ -953,7 +1218,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = errorR(Error(FSComp.SR.chkNoAddressStaticFieldAtThisPoint(rfref.FieldName), m)) CheckTypeInstNoByrefs cenv env m tyargs - false + NoLimit // Check get of instance field | TOp.ValFieldGetAddr (rfref, _readonly),tyargs,[obj] -> @@ -1021,7 +1286,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = if context.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(fspec.Name), m)) - false + NoLimit | [ I_ldflda (fspec) ], [obj] -> if context.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then @@ -1035,7 +1300,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = errorR(Error(FSComp.SR.chkNoAddressOfArrayElementAtThisPoint(), m)) // permit byref for lhs lvalue let limit = CheckExprPermitByRefLike cenv env lhsArray - CheckExprsNoByRefLike cenv env indices |> ignoreLimit + CheckExprsNoByRefLike cenv env indices |> ignore limit | [ AI_conv _ ],_ -> @@ -1048,24 +1313,27 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = | TOp.TraitCall _,_,_ -> CheckTypeInstNoByrefs cenv env m tyargs // allow args to be byref here - CheckExprsPermitByRefLike cenv env args + CheckExprsPermitByRefLike cenv env args + + | TOp.Recd(_, _), _, _ -> + CheckTypeInstNoByrefs cenv env m tyargs + CheckExprsPermitByRefLike cenv env args | _ -> CheckTypeInstNoByrefs cenv env m tyargs CheckExprsNoByRefLike cenv env args -and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValInfo alwaysCheckNoReraise e m ety = +and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValInfo alwaysCheckNoReraise e m ety context = let g = cenv.g // The topValInfo here says we are _guaranteeing_ to compile a function value // as a .NET method with precisely the corresponding argument counts. match e with | Expr.TyChoose(tps,e1,m) -> let env = BindTypars g env tps - CheckLambdas isTop memInfo cenv env inlined topValInfo alwaysCheckNoReraise e1 m ety + CheckLambdas isTop memInfo cenv env inlined topValInfo alwaysCheckNoReraise e1 m ety context | Expr.Lambda (_,_,_,_,_,m,_) | Expr.TyLambda(_,_,_,m,_) -> - let tps,ctorThisValOpt,baseValOpt,vsl,body,bodyty = destTopLambda g cenv.amap topValInfo (e, ety) in let env = BindTypars g env tps let thisAndBase = Option.toList ctorThisValOpt @ Option.toList baseValOpt @@ -1100,13 +1368,11 @@ and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValIn CheckNoReraise cenv freesOpt body // Check the body of the lambda - let limit = - if isTop && not g.compilingFslib && isByrefLikeTy g m bodyty then - // allow byref to occur as return position for byref-typed top level function or method - CheckExprPermitReturnableByRef cenv env body - else - CheckExprNoByrefs cenv env body - false + if isTop && not g.compilingFslib && isByrefLikeTy g m bodyty then + // allow byref to occur as return position for byref-typed top level function or method + CheckExprPermitReturnableByRef cenv env body |> ignore + else + CheckExprNoByrefs cenv env body // Check byref return types if cenv.reportErrors then @@ -1119,14 +1385,11 @@ and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValIn CheckForByrefType cenv env (destByrefTy g bodyty) (fun () -> errorR(Error(FSComp.SR.chkReturnTypeNoByref(), m))) - if limit then - errorR(Error(FSComp.SR.chkNoReturnOfLimitedSpan(), m)) - for tp in tps do if tp.Constraints |> List.sumBy (function TyparConstraint.CoercesTo(ty,_) when isClassTy g ty -> 1 | _ -> 0) > 1 then errorR(Error(FSComp.SR.chkTyparMultipleClassConstraints(), m)) - false + NoLimit // This path is for expression bindings that are not actually lambdas | _ -> @@ -1135,42 +1398,46 @@ and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValIn let limit = if not inlined && (isByrefLikeTy g m ety || isNativePtrTy g ety) then // allow byref to occur as RHS of byref binding. - CheckExprPermitByRefLike cenv env e + CheckExpr cenv env e context else CheckExprNoByrefs cenv env e - false + NoLimit if alwaysCheckNoReraise then CheckNoReraise cenv None e limit -and CheckExprs cenv env exprs contexts : bool = +and CheckExprs cenv env exprs contexts : Limit = let contexts = Array.ofList contexts let argArity i = if i < contexts.Length then contexts.[i] else PermitByRefExpr.No - let limits = exprs |> List.mapi (fun i exp -> CheckExpr cenv env exp (argArity i)) - limits |> List.existsTrue + exprs + |> List.mapi (fun i exp -> CheckExpr cenv env exp (argArity i)) + |> CombineLimits -and CheckExprsNoByRefLike cenv env exprs : bool = +and CheckExprsNoByRefLike cenv env exprs : Limit = exprs |> List.iter (CheckExprNoByrefs cenv env) - false + NoLimit and CheckExprsPermitByRefLike cenv env exprs = - let limits = exprs |> List.map (CheckExprPermitByRefLike cenv env) - limits |> List.existsTrue + exprs + |> List.map (CheckExprPermitByRefLike cenv env) + |> CombineLimits -and CheckExprsPermitReturnableByRef cenv env exprs : bool = - let limits = exprs |> List.map (CheckExprPermitReturnableByRef cenv env) - limits |> List.existsTrue +and CheckExprsPermitReturnableByRef cenv env exprs : Limit = + exprs + |> List.map (CheckExprPermitReturnableByRef cenv env) + |> CombineLimits -and CheckExprPermitByRefLike cenv env expr = +and CheckExprPermitByRefLike cenv env expr : Limit = CheckExpr cenv env expr PermitByRefExpr.Yes -and CheckExprPermitReturnableByRef cenv env expr : bool = +and CheckExprPermitReturnableByRef cenv env expr : Limit = CheckExpr cenv env expr PermitByRefExpr.YesReturnable and CheckDecisionTreeTargets cenv env targets context = - let limits = targets |> Array.map (CheckDecisionTreeTarget cenv env context) - limits |> Array.existsTrue + targets + |> Array.map (CheckDecisionTreeTarget cenv env context) + |> (CombineLimits << List.ofArray) and CheckDecisionTreeTarget cenv env context (TTarget(vs,e,_)) = BindVals cenv env vs @@ -1180,15 +1447,15 @@ and CheckDecisionTreeTarget cenv env context (TTarget(vs,e,_)) = and CheckDecisionTree cenv env x = match x with | TDSuccess (es,_) -> - CheckExprsNoByRefLike cenv env es |> ignoreLimit + CheckExprsNoByRefLike cenv env es |> ignore | TDBind(bind,rest) -> - CheckBinding cenv env false bind |> ignoreLimit + CheckBinding cenv env false PermitByRefExpr.Yes bind |> ignore CheckDecisionTree cenv env rest | TDSwitch (e,cases,dflt,m) -> CheckDecisionTreeSwitch cenv env (e,cases,dflt,m) and CheckDecisionTreeSwitch cenv env (e,cases,dflt,m) = - CheckExprPermitByRefLike cenv env e |> ignoreLimit // can be byref for struct union switch + CheckExprPermitByRefLike cenv env e |> ignore// 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) @@ -1296,7 +1563,7 @@ and AdjustAccess isHidden (cpath: unit -> CompilationPath) access = else access -and CheckBinding cenv env alwaysCheckNoReraise (TBind(v,bindRhs,_) as bind) : bool = +and CheckBinding cenv env alwaysCheckNoReraise context (TBind(v,bindRhs,_) as bind) : Limit = let g = cenv.g let isTop = Option.isSome bind.Var.ValReprInfo //printfn "visiting %s..." v.DisplayName @@ -1394,10 +1661,10 @@ and CheckBinding cenv env alwaysCheckNoReraise (TBind(v,bindRhs,_) as bind) : bo let topValInfo = match bind.Var.ValReprInfo with Some info -> info | _ -> ValReprInfo.emptyValData - CheckLambdas isTop v.MemberInfo cenv env v.MustInline topValInfo alwaysCheckNoReraise bindRhs v.Range v.Type + CheckLambdas isTop v.MemberInfo cenv env v.MustInline topValInfo alwaysCheckNoReraise bindRhs v.Range v.Type context and CheckBindings cenv env xs = - xs |> List.iter (CheckBinding cenv env false >> ignoreLimit) + xs |> List.iter (CheckBinding cenv env false PermitByRefExpr.Yes >> ignore) // Top binds introduce expression, check they are reraise free. let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = @@ -1525,7 +1792,7 @@ let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = with e -> errorRecovery e v.Range end - CheckBinding cenv env true bind |> ignoreLimit + CheckBinding cenv { env with returnScope = 1 } true PermitByRefExpr.Yes bind |> ignore let CheckModuleBindings cenv env binds = binds |> List.iter (CheckModuleBinding cenv env) @@ -1538,22 +1805,23 @@ let CheckRecdField isUnion cenv env (tycon:Tycon) (rfield:RecdField) = let g = cenv.g let tcref = mkLocalTyconRef tycon let m = rfield.Range + let fieldTy = stripTyEqns cenv.g rfield.FormalType let isHidden = IsHiddenTycon env.sigToImplRemapInfo tycon || IsHiddenTyconRepr env.sigToImplRemapInfo tycon || (not isUnion && IsHiddenRecdField env.sigToImplRemapInfo (tcref.MakeNestedRecdFieldRef rfield)) let access = AdjustAccess isHidden (fun () -> tycon.CompilationPath) rfield.Accessibility - CheckTypeForAccess cenv env (fun () -> rfield.Name) access m rfield.FormalType + CheckTypeForAccess cenv env (fun () -> rfield.Name) access m fieldTy if TyconRefHasAttribute g m g.attrib_IsByRefLikeAttribute tcref then // Permit Span fields in IsByRefLike types - CheckTypePermitOuterSpanLike cenv env m rfield.FormalType + CheckTypePermitSpanLike cenv env m fieldTy if cenv.reportErrors then - CheckForByrefType cenv env rfield.FormalType (fun () -> errorR(Error(FSComp.SR.chkCantStoreByrefValue(), tycon.Range))) + CheckForByrefType cenv env fieldTy (fun () -> errorR(Error(FSComp.SR.chkCantStoreByrefValue(), tycon.Range))) else - CheckTypeNoByrefs cenv env m rfield.FormalType + CheckTypeNoByrefs cenv env m fieldTy if cenv.reportErrors then - CheckForByrefLikeType cenv env m rfield.FormalType (fun () -> errorR(Error(FSComp.SR.chkCantStoreByrefValue(), tycon.Range))) + CheckForByrefLikeType cenv env m fieldTy (fun () -> errorR(Error(FSComp.SR.chkCantStoreByrefValue(), tycon.Range))) CheckAttribs cenv env rfield.PropertyAttribs CheckAttribs cenv env rfield.FieldAttribs @@ -1787,8 +2055,8 @@ let CheckEntityDefn cenv env (tycon:Entity) = let env = BindTypars g env tps for argtys in argtysl do for (argty, _) in argtys do - CheckTypePermitOuterByRefLike cenv env m argty - CheckTypePermitOuterByRefLike cenv env m rty + CheckTypePermitAllByrefs cenv env m argty + CheckTypePermitAllByrefs cenv env m rty | None -> () @@ -1910,7 +2178,7 @@ and CheckModuleSpec cenv env x = 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 CheckTopImpl (g,amap,reportErrors,infoReader,internalsVisibleToPaths,viewCcu,denv ,mexpr,extraAttribs,(isLastCompiland:bool*bool),isInternalTestSpanStackReferring) = let cenv = { g =g reportErrors=reportErrors @@ -1923,7 +2191,8 @@ let CheckTopImpl (g,amap,reportErrors,infoReader,internalsVisibleToPaths,viewCcu amap=amap denv=denv viewCcu= viewCcu - isLastCompiland=isLastCompiland + isLastCompiland=isLastCompiland + isInternalTestSpanStackReferring = isInternalTestSpanStackReferring entryPointGiven=false} // Certain type equality checks go faster if these TyconRefs are pre-resolved. @@ -1945,7 +2214,8 @@ let CheckTopImpl (g,amap,reportErrors,infoReader,internalsVisibleToPaths,viewCcu argVals = ValMap.Empty boundTypars= TyparMap.Empty reflect=false - external=false } + external=false + returnScope = 0 } CheckModuleExpr cenv env mexpr CheckAttribs cenv env extraAttribs diff --git a/src/fsharp/PostInferenceChecks.fsi b/src/fsharp/PostInferenceChecks.fsi index d918df258a..970c143155 100644 --- a/src/fsharp/PostInferenceChecks.fsi +++ b/src/fsharp/PostInferenceChecks.fsi @@ -11,4 +11,4 @@ open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.TcGlobals val testFlagMemberBody : bool ref -val CheckTopImpl : TcGlobals * ImportMap * bool * InfoReader * CompilationPath list * CcuThunk * DisplayEnv * ModuleOrNamespaceExprWithSig * Attribs * (bool * bool) -> bool +val CheckTopImpl : TcGlobals * ImportMap * bool * InfoReader * CompilationPath list * CcuThunk * DisplayEnv * ModuleOrNamespaceExprWithSig * Attribs * (bool * bool) * isInternalTestSpanStackReferring: bool -> bool diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 19912183b8..db888dd8f9 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -2956,9 +2956,17 @@ let isByrefLikeTyconRef (g: TcGlobals) m (tcref: TyconRef) = tcref.SetIsByRefLike res res +let isSpanLikeTyconRef g m tcref = + isByrefLikeTyconRef g m tcref && + not (isByrefTyconRef g tcref) + let isByrefLikeTy g m ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isByrefLikeTyconRef g m tcref | _ -> false) +let isSpanLikeTy g m ty = + isByrefLikeTy g m ty && + not (isByrefTy g ty) + //------------------------------------------------------------------------- // List and reference types... //------------------------------------------------------------------------- @@ -5856,7 +5864,9 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress if isStructTy g ty then match mut with | NeverMutates -> () - | AddressOfOp -> () // we get an inref + | AddressOfOp -> + // we get an inref + errorR(Error(FSComp.SR.tastCantTakeAddressOfExpression(), m)) | DefinitelyMutates -> // Give a nice error message for mutating something we can't take the address of errorR(Error(FSComp.SR.tastInvalidMutationOfConstant(), m)) diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi index 6bc9a53b2e..d2a532c37a 100755 --- a/src/fsharp/TastOps.fsi +++ b/src/fsharp/TastOps.fsi @@ -1451,8 +1451,12 @@ val destNativePtrTy : TcGlobals -> TType -> TType val isByrefTyconRef : TcGlobals -> TyconRef -> bool val isByrefLikeTyconRef : TcGlobals -> range -> TyconRef -> bool +val isSpanLikeTyconRef : TcGlobals -> range -> TyconRef -> bool val isByrefLikeTy : TcGlobals -> range -> TType -> bool +/// Check if the type is a byref-like but not a byref. +val isSpanLikeTy : TcGlobals -> range -> TType -> bool + //------------------------------------------------------------------------- // Tuple constructors/destructors //------------------------------------------------------------------------- diff --git a/src/fsharp/TastPickle.fs b/src/fsharp/TastPickle.fs index 6bc5636525..3f184165ad 100755 --- a/src/fsharp/TastPickle.fs +++ b/src/fsharp/TastPickle.fs @@ -505,9 +505,13 @@ let p_maybe_lazy p (x: MaybeLazy<_>) st = p_lazy_impl p x.Value st let p_hole () = - let h = ref (None : 'T pickler option) + let h = ref (None : ('T -> WriterState -> unit) option) (fun f -> h := Some f),(fun x st -> match !h with Some f -> f x st | None -> pfailwith st "p_hole: unfilled hole") +let p_hole2 () = + let h = ref (None : ('Arg -> 'T -> WriterState -> unit) option) + (fun f -> h := Some f),(fun arg x st -> match !h with Some f -> f arg x st | None -> pfailwith st "p_hole2: unfilled hole") + let u_array_core f n st = let res = Array.zeroCreate n for i = 0 to n-1 do @@ -1263,11 +1267,20 @@ let u_rfref st = let a,b = u_tup2 u_tcref u_string st in RFRef(a,b) let u_tpref st = u_local_item_ref st.itypars st // forward reference -let fill_p_ty,p_ty = p_hole() +let fill_p_ty2,p_ty2 = p_hole2() + +let p_ty = p_ty2 false let p_tys = (p_list p_ty) let fill_p_attribs,p_attribs = p_hole() +// In F# 4.5, the type of the "this" pointer for structs is considered to be inref for the purposes of checking the implementation +// of the struct. However for backwards compat reaons we can't serialize this as the type. +let checkForInRefStructThisArg st ty = + let g = st.oglobals + let _, tauTy = tryDestForallTy g ty + isFunTy g tauTy && isFunTy g (rangeOfFunTy g tauTy) && isInByrefTy g (domainOfFunTy g tauTy) + let p_nonlocal_val_ref (nlv:NonLocalValOrMemberRef) st = let a = nlv.EnclosingEntity let key = nlv.ItemKey @@ -1277,7 +1290,11 @@ let p_nonlocal_val_ref (nlv:NonLocalValOrMemberRef) st = p_bool pkey.MemberIsOverride st p_string pkey.LogicalName st p_int pkey.TotalArgCount st - p_option p_ty key.TypeForLinkage st + let isStructThisArgPos = + match key.TypeForLinkage with + | None -> false + | Some ty -> checkForInRefStructThisArg st ty + p_option (p_ty2 isStructThisArgPos) key.TypeForLinkage st let rec p_vref ctxt x st = match x with @@ -1537,8 +1554,17 @@ let u_tyar_spec st = let u_tyar_specs = (u_list u_tyar_spec) -let _ = fill_p_ty (fun ty st -> +let _ = fill_p_ty2 (fun isStructThisArgPos ty st -> let ty = stripTyparEqns ty + + // See comment on 'checkForInRefStructThisArg' + let ty = + if isInByrefTy st.oglobals ty && isStructThisArgPos then + // Convert the inref to a byref + mkByrefTy st.oglobals (destByrefTy st.oglobals ty) + else + ty + match ty with | TType_tuple (tupInfo,l) -> if evalTupInfoIsStruct tupInfo then @@ -1547,9 +1573,17 @@ let _ = fill_p_ty (fun ty st -> p_byte 0 st; p_tys l st | TType_app(ERefNonLocal nleref,[]) -> p_byte 1 st; p_simpletyp nleref st | TType_app (tc,tinst) -> p_byte 2 st; p_tup2 (p_tcref "typ") p_tys (tc,tinst) st - | TType_fun (d,r) -> p_byte 3 st; p_tup2 p_ty p_ty (d,r) st + | TType_fun (d,r) -> + p_byte 3 st + // Note, the "this" argument may be found in the domain position of a function type, so propagate the isStructThisArgPos value + p_ty2 isStructThisArgPos d st + p_ty r st | TType_var r -> p_byte 4 st; p_tpref r st - | TType_forall (tps,r) -> p_byte 5 st; p_tup2 p_tyar_specs p_ty (tps,r) st + | TType_forall (tps,r) -> + p_byte 5 st + p_tyar_specs tps st + // Note, the "this" argument may be found in the body of a generic forall type, so propagate the isStructThisArgPos value + p_ty2 isStructThisArgPos r st | TType_measure unt -> p_byte 6 st; p_measure_expr unt st | TType_ucase (uc,tinst) -> p_byte 7 st; p_tup2 p_ucref p_tys (uc,tinst) st) @@ -1815,7 +1849,10 @@ and p_ValData x st = p_option p_string x.ValCompiledName st // only keep range information on published values, not on optimization data p_ranges (x.ValReprInfo |> Option.map (fun _ -> x.val_range, x.DefinitionRange)) st - p_ty x.val_type st + + let isStructThisArgPos = x.IsMember && checkForInRefStructThisArg st x.Type + p_ty2 isStructThisArgPos x.val_type st + p_int64 x.val_flags.PickledBits st p_option p_member_info x.MemberInfo st p_attribs x.Attribs st diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index b068a063f3..badd093e4d 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -507,10 +507,11 @@ type cenv = /// The set of active conditional defines conditionalDefines: string list + isInternalTestSpanStackReferring: bool } /// Create a new compilation environment - static member Create (g, isScript, niceNameGen, amap, topCcu, isSig, haveSig, conditionalDefines, tcSink, tcVal) = + static member Create (g, isScript, niceNameGen, amap, topCcu, isSig, haveSig, conditionalDefines, tcSink, tcVal, isInternalTestSpanStackReferring) = let infoReader = new InfoReader(g, amap) let instantiationGenerator m tpsorig = ConstraintSolver.FreshenTypars m tpsorig let nameResolver = new NameResolver(g, amap, infoReader, instantiationGenerator) @@ -530,7 +531,8 @@ type cenv = isSig = isSig haveSig = haveSig compilingCanonicalFslibModuleType = (isSig || not haveSig) && g.compilingFslib - conditionalDefines = conditionalDefines } + conditionalDefines = conditionalDefines + isInternalTestSpanStackReferring = isInternalTestSpanStackReferring } override __.ToString() = "cenv(...)" @@ -905,23 +907,7 @@ let TcConst cenv ty m env c = | SynConst.Bytes _ -> error (InternalError(FSComp.SR.tcUnexpectedConstByteArray(), m)) /// Convert an Abstract IL ILFieldInit value read from .NET metadata to a TAST constant -let TcFieldInit (_m:range) lit = - match lit with - | ILFieldInit.String s -> Const.String s - | ILFieldInit.Null -> Const.Zero - | ILFieldInit.Bool b -> Const.Bool b - | ILFieldInit.Char c -> Const.Char (char (int c)) - | ILFieldInit.Int8 x -> Const.SByte x - | ILFieldInit.Int16 x -> Const.Int16 x - | ILFieldInit.Int32 x -> Const.Int32 x - | ILFieldInit.Int64 x -> Const.Int64 x - | ILFieldInit.UInt8 x -> Const.Byte x - | ILFieldInit.UInt16 x -> Const.UInt16 x - | ILFieldInit.UInt32 x -> Const.UInt32 x - | ILFieldInit.UInt64 x -> Const.UInt64 x - | ILFieldInit.Single f -> Const.Single f - | ILFieldInit.Double f -> Const.Double f - +let TcFieldInit (_m:range) lit = PatternMatchCompilation.ilFieldToTastConst lit //------------------------------------------------------------------------- // Arities. These serve two roles in the system: @@ -2170,11 +2156,13 @@ module GeneralizationHelpers = // Some situations, e.g. implicit class constructions that represent functions as fields, // do not allow generalisation over constrained typars. (since they can not be represented as fields) + // + // Don't generalize IsCompatFlex type parameters to avoid changing inferred types. let generalizedTypars, ungeneralizableTypars3 = generalizedTypars |> List.partition (fun tp -> - genConstrainedTyparFlag = CanGeneralizeConstrainedTypars || - tp.Constraints.IsEmpty) + (genConstrainedTyparFlag = CanGeneralizeConstrainedTypars || tp.Constraints.IsEmpty) && + not tp.IsCompatFlex) if isNil ungeneralizableTypars1 && isNil ungeneralizableTypars2 && isNil ungeneralizableTypars3 then generalizedTypars, freeInEnv @@ -2939,7 +2927,7 @@ let TcRuntimeTypeTest isCast isOperator cenv denv m tgty srcTy = if TypeDefinitelySubsumesTypeNoCoercion 0 cenv.g cenv.amap m tgty srcTy then warning(TypeTestUnnecessary(m)) - if isTyparTy cenv.g srcTy then + if isTyparTy cenv.g srcTy && not (destTyparTy cenv.g srcTy).IsCompatFlex then error(IndeterminateRuntimeCoercion(denv, srcTy, tgty, m)) if isSealedTy cenv.g srcTy then @@ -2965,9 +2953,11 @@ let TcRuntimeTypeTest isCast isOperator cenv denv m tgty srcTy = /// Checks, warnings and constraint assertions for upcasts let TcStaticUpcast cenv denv m tgty srcTy = if isTyparTy cenv.g tgty then - error(IndeterminateStaticCoercion(denv, srcTy, tgty, m)) + if not (destTyparTy cenv.g tgty).IsCompatFlex then + error(IndeterminateStaticCoercion(denv, srcTy, tgty, m)) + //else warning(UpcastUnnecessary(m)) - if isSealedTy cenv.g tgty then + if isSealedTy cenv.g tgty && not (isTyparTy cenv.g tgty) then warning(CoercionTargetSealed(denv, tgty, m)) if typeEquiv cenv.g srcTy tgty then @@ -2975,10 +2965,6 @@ let TcStaticUpcast cenv denv m tgty srcTy = AddCxTypeMustSubsumeType ContextInfo.NoContext denv cenv.css m NoTrace tgty srcTy - - - - let BuildPossiblyConditionalMethodCall cenv env isMutable m isProp minfo valUseFlags minst objArgs args = let conditionalCallDefineOpt = TryFindMethInfoStringAttribute cenv.g m cenv.g.attrib_ConditionalAttribute minfo @@ -3333,10 +3319,19 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr let getEnumTy = mkRefCellTy cenv.g getEnumTy getEnumExpr, getEnumTy - let guardExpr , guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNext_minfo NormalValUse moveNext_minst [enumeratorExpr] [] - let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true get_Current_minfo NormalValUse get_Current_minst [enumeratorExpr] [] - let betterCurrentExpr = mkCoerceExpr(currentExpr, enumElemTy, currentExpr.Range, currentTy) - Result(enumeratorVar, enumeratorExpr, retTypeOfGetEnumerator, enumElemTy, getEnumExpr, getEnumTy, guardExpr, guardTy, betterCurrentExpr) + let guardExpr , guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNext_minfo NormalValUse moveNext_minst [enumeratorExpr] [] + let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true get_Current_minfo NormalValUse get_Current_minst [enumeratorExpr] [] + let currentExpr = mkCoerceExpr(currentExpr, enumElemTy, currentExpr.Range, currentTy) + let currentExpr, enumElemTy = + // Implicitly dereference byref for expr 'for x in ...' + if isByrefTy cenv.g enumElemTy then + let v, _ = mkCompGenLocal m "byrefReturn" enumElemTy + let expr = mkCompGenLet currentExpr.Range v currentExpr (mkAddrGet m (mkLocalValRef v)) + expr, destByrefTy cenv.g enumElemTy + else + currentExpr, enumElemTy + + Result(enumeratorVar, enumeratorExpr, retTypeOfGetEnumerator, enumElemTy, getEnumExpr, getEnumTy, guardExpr, guardTy, currentExpr) // First try the original known static type match (if isArray1DTy cenv.g exprty then Exception (Failure "") else tryType (expr, exprty)) with @@ -5525,9 +5520,11 @@ and TcExprOfUnknownType cenv env tpenv expr = let expr', tpenv = TcExpr cenv exprty env tpenv expr expr', exprty, tpenv -and TcExprFlex cenv flex ty (env: TcEnv) tpenv (e: SynExpr) = +and TcExprFlex cenv flex compat ty (env: TcEnv) tpenv (e: SynExpr) = if flex then let argty = NewInferenceType () + if compat then + (destTyparTy cenv.g argty).SetIsCompatFlex(true) AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css e.Range NoTrace ty argty let e', tpenv = TcExpr cenv argty env tpenv e let e' = mkCoerceIfNeeded cenv.g ty argty e' @@ -5657,7 +5654,7 @@ and TcExprThen cenv overallTy env tpenv synExpr delayed = and TcExprs cenv env m tpenv flexes argtys args = if List.length args <> List.length argtys then error(Error(FSComp.SR.tcExpressionCountMisMatch((List.length argtys), (List.length args)), m)) (tpenv, List.zip3 flexes argtys args) ||> List.mapFold (fun tpenv (flex, ty, e) -> - TcExprFlex cenv flex ty env tpenv e) + TcExprFlex cenv flex false ty env tpenv e) and CheckSuperInit cenv objTy m = // Check the type is not abstract @@ -5822,7 +5819,7 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = else { env with eContextInfo = ContextInfo.CollectionElement (isArray, m) } - let args', tpenv = List.mapFold (fun tpenv (x:SynExpr) -> TcExprFlex cenv flex argty (getInitEnv x.Range) tpenv x) tpenv args + let args', tpenv = List.mapFold (fun tpenv (x:SynExpr) -> TcExprFlex cenv flex false argty (getInitEnv x.Range) tpenv x) tpenv args let expr = if isArray then Expr.Op(TOp.Array, [argty], args', m) @@ -5909,19 +5906,37 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = TcExprUndelayed cenv overallTy env tpenv replacementExpr | _ -> + let genCollElemTy = NewInferenceType () + let genCollTy = (if isArray then mkArrayType else mkListTy) cenv.g genCollElemTy + UnifyTypes cenv env m overallTy genCollTy - let exprty = NewInferenceType () - let genEnumTy = mkSeqTy cenv.g genCollElemTy - AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace genEnumTy exprty + + let exprty = mkSeqTy cenv.g genCollElemTy + + // Check the comprehension let expr, tpenv = TcExpr cenv exprty env tpenv comp - let expr = mkCoerceIfNeeded cenv.g genEnumTy (tyOfExpr cenv.g expr) expr - (if isArray then mkCallSeqToArray else mkCallSeqToList) cenv.g m genCollElemTy - // We add a call to 'seq ... ' to make sure sequence expression compilation gets applied to the contents of the - // comprehension. But don't do this in FSharp.Core.dll since 'seq' may not yet be defined. - ((if cenv.g.compilingFslib then id else mkCallSeq cenv.g m genCollElemTy) - (mkCoerceExpr(expr, genEnumTy, expr.Range, exprty))), tpenv + + let expr = mkCoerceIfNeeded cenv.g exprty (tyOfExpr cenv.g expr) expr + + let expr = + if cenv.g.compilingFslib then + expr + else + // We add a call to 'seq ... ' to make sure sequence expression compilation gets applied to the contents of the + // comprehension. But don't do this in FSharp.Core.dll since 'seq' may not yet be defined. + mkCallSeq cenv.g m genCollElemTy expr + + let expr = mkCoerceExpr(expr, exprty, expr.Range, overallTy) + + let expr = + if isArray then + mkCallSeqToArray cenv.g m genCollElemTy expr + else + mkCallSeqToList cenv.g m genCollElemTy expr + + expr, tpenv | SynExpr.LetOrUse _ -> TcLinearExprs (TcExprThatCanBeCtorBody cenv) cenv env overallTy tpenv false expr (fun x -> x) @@ -6140,6 +6155,7 @@ and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = | e -> // Dive into the expression to check for syntax errors and suppress them if they show. conditionallySuppressErrorReporting (not isFirst && synExprContainsError e) (fun () -> + //TcExprFlex cenv true true overallTy env tpenv e) TcExpr cenv overallTy env tpenv e) @@ -6350,7 +6366,7 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = let fldsList, tpenv = let env = { env with eContextInfo = ContextInfo.RecordFields } (tpenv, fldsList) ||> List.mapFold (fun tpenv (fname, fexpr, fty, flex) -> - let fieldExpr, tpenv = TcExprFlex cenv flex fty env tpenv fexpr + let fieldExpr, tpenv = TcExprFlex cenv flex false fty env tpenv fexpr (fname, fieldExpr), tpenv) // Add rebindings for unbound field when an "old value" is available @@ -8148,6 +8164,12 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv /// Also "ienumerable extraction" is performed on arguments to "for". and TcSequenceExpression cenv env tpenv comp overallTy m = + let genEnumElemTy = NewInferenceType () + UnifyTypes cenv env m overallTy (mkSeqTy cenv.g genEnumElemTy) + + // Allow subsumption at 'yield' if the element type is nominal prior to the analysis of the body of the sequence expression + let flex = not (isTyparTy cenv.g genEnumElemTy) + let mkDelayedExpr (coreExpr:Expr) = let m = coreExpr.Range let overallTy = tyOfExpr cenv.g coreExpr @@ -8297,7 +8319,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = if not isYield then errorR(Error(FSComp.SR.tcSeqResultsUseYield(), m)) UnifyTypes cenv env m genOuterTy (mkSeqTy cenv.g genResultTy) - let resultExpr, tpenv = TcExpr cenv genResultTy env tpenv yieldExpr + let resultExpr, tpenv = TcExprFlex cenv flex true genResultTy env tpenv yieldExpr Some(mkCallSeqSingleton cenv.g m genResultTy resultExpr, tpenv ) | _ -> None @@ -8313,9 +8335,6 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = let expr, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp Expr.Sequential(expr, mkSeqEmpty cenv env m genOuterTy, NormalSeq, SuppressSequencePointOnStmtOfSequential, m), tpenv - let genEnumElemTy = NewInferenceType () - UnifyTypes cenv env m overallTy (mkSeqTy cenv.g genEnumElemTy) - let coreExpr, tpenv = tcSequenceExprBody env overallTy tpenv comp let delayedExpr = mkDelayedExpr coreExpr delayedExpr, tpenv @@ -8434,7 +8453,7 @@ and TcDelayed cenv overallTy env tpenv mExpr expr exprty (atomicFlag:ExprAtomicF let _wrap, exprAddress, _readonly, _writeonly = mkExprAddrOfExpr cenv.g true false DefinitelyMutates expr None mExpr let vty = tyOfExpr cenv.g expr // Always allow subsumption on assignment to fields - let expr2, tpenv = TcExprFlex cenv true vty env tpenv synExpr2 + let expr2, tpenv = TcExprFlex cenv true false vty env tpenv synExpr2 let v, _ve = mkCompGenLocal mExpr "addr" (mkByrefTy cenv.g vty) mkCompGenLet mStmt v exprAddress (mkAddrSet mStmt (mkLocalValRef v) expr2), tpenv @@ -8939,7 +8958,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del if not vref.IsMutable then error (ValNotMutable(env.DisplayEnv, vref, mStmt)) vty // Always allow subsumption on assignment to fields - let e2', tpenv = TcExprFlex cenv true vty2 env tpenv e2 + let e2', tpenv = TcExprFlex cenv true false vty2 env tpenv e2 let vexp = if isInByrefTy cenv.g vty then errorR(Error(FSComp.SR.writeToReadOnlyByref(), mStmt)) @@ -9018,7 +9037,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del | DelayedSet(e2, mStmt) :: _delayed' -> UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty // Always allow subsumption on assignment to fields - let e2', tpenv = TcExprFlex cenv true exprty env tpenv e2 + let e2', tpenv = TcExprFlex cenv true false exprty env tpenv e2 let expr = BuildILStaticFieldSet mStmt finfo e2' expr, tpenv | _ -> @@ -9056,7 +9075,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty let fieldTy = rfinfo.FieldType // Always allow subsumption on assignment to fields - let e2', tpenv = TcExprFlex cenv true fieldTy env tpenv e2 + let e2', tpenv = TcExprFlex cenv true false fieldTy env tpenv e2 let expr = mkStaticRecdFieldSet (rfinfo.RecdFieldRef, rfinfo.TypeInst, e2', mStmt) expr, tpenv | _ -> @@ -9205,7 +9224,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela CheckRecdFieldMutation mItem env.DisplayEnv rfinfo UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty // Always allow subsumption on assignment to fields - let e2', tpenv = TcExprFlex cenv true fieldTy env tpenv e2 + let e2', tpenv = TcExprFlex cenv true false fieldTy env tpenv e2 BuildRecdFieldSet cenv.g mStmt objExpr rfinfo e2', tpenv | _ -> @@ -9224,7 +9243,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela | DelayedSet(e2, mStmt) :: _delayed' -> UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty // Always allow subsumption on assignment to fields - let e2', tpenv = TcExprFlex cenv true exprty env tpenv e2 + let e2', tpenv = TcExprFlex cenv true false exprty env tpenv e2 let expr = BuildILFieldSet cenv.g mStmt objExpr finfo e2' expr, tpenv | _ -> @@ -9788,9 +9807,11 @@ and TcMethodApplication if isByrefTy g calledArgTy && isRefCellTy g callerArgTy then None, Expr.Op(TOp.RefAddrGet false, [destRefCellTy g callerArgTy], [callerArgExpr], m) +#if IMPLICIT_ADDRESS_OF elif isInByrefTy g calledArgTy && not (isByrefTy cenv.g callerArgTy) then let wrap, callerArgExprAddress, _readonly, _writeonly = mkExprAddrOfExpr g true false NeverMutates callerArgExpr None m Some wrap, callerArgExprAddress +#endif elif isDelegateTy cenv.g calledArgTy && isFunTy cenv.g callerArgTy then None, CoerceFromFSharpFuncToDelegate cenv.g cenv.amap cenv.infoReader ad callerArgTy m callerArgExpr calledArgTy @@ -17222,13 +17243,13 @@ let CheckModuleSignature g cenv m denvAtEnd rootSigOpt implFileTypePriorToSig im /// Typecheck, then close the inference scope and then check the file meets its signature (if any) let TypeCheckOneImplFile // checkForErrors: A function to help us stop reporting cascading errors - (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink) + (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) env (rootSigOpt : ModuleOrNamespaceType option) (ParsedImplFileInput(_, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland)) = eventually { - let cenv = cenv.Create (g, isScript, niceNameGen, amap, topCcu, false, Option.isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g)) + let cenv = cenv.Create (g, isScript, niceNameGen, amap, topCcu, false, Option.isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring) let envinner, mtypeAcc = MakeInitialEnv env @@ -17292,7 +17313,7 @@ let TypeCheckOneImplFile conditionallySuppressErrorReporting (checkForErrors()) (fun () -> try let reportErrors = not (checkForErrors()) - PostTypeCheckSemanticChecks.CheckTopImpl (g, cenv.amap, reportErrors, cenv.infoReader, env.eInternalsVisibleCompPaths, cenv.topCcu, envAtEnd.DisplayEnv, implFileExprAfterSig, extraAttribs, isLastCompiland) + PostTypeCheckSemanticChecks.CheckTopImpl (g, cenv.amap, reportErrors, cenv.infoReader, env.eInternalsVisibleCompPaths, cenv.topCcu, envAtEnd.DisplayEnv, implFileExprAfterSig, extraAttribs, isLastCompiland, isInternalTestSpanStackReferring) with e -> errorRecovery e m false) @@ -17305,7 +17326,6 @@ let TypeCheckOneImplFile try IL.parseILVersion version |> ignore; true with _ -> false match attrName with - | "System.Reflection.AssemblyInformationalVersionAttribute" | "System.Reflection.AssemblyFileVersionAttribute" //TODO compile error like c# compiler? | "System.Reflection.AssemblyVersionAttribute" when not (isValid()) -> warning(Error(FSComp.SR.fscBadAssemblyVersion(attrName, version), range)) @@ -17320,9 +17340,9 @@ let TypeCheckOneImplFile /// Check an entire signature file -let TypeCheckOneSigFile (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink) tcEnv (ParsedSigFileInput(_, qualNameOfFile, _, _, sigFileFrags)) = +let TypeCheckOneSigFile (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (ParsedSigFileInput(_, qualNameOfFile, _, _, sigFileFrags)) = eventually { - let cenv = cenv.Create (g, false, niceNameGen, amap, topCcu, true, false, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g)) + let cenv = cenv.Create (g, false, niceNameGen, amap, topCcu, true, false, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring) let envinner, mtypeAcc = MakeInitialEnv tcEnv let specs = [ for x in sigFileFrags -> SynModuleSigDecl.NamespaceFragment(x) ] diff --git a/src/fsharp/TypeChecker.fsi b/src/fsharp/TypeChecker.fsi index b49d6574b7..3f84e1992f 100644 --- a/src/fsharp/TypeChecker.fsi +++ b/src/fsharp/TypeChecker.fsi @@ -39,14 +39,14 @@ val EmptyTopAttrs : TopAttribs val CombineTopAttrs : TopAttribs -> TopAttribs -> TopAttribs val TypeCheckOneImplFile : - TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink + TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink * bool -> TcEnv -> Tast.ModuleOrNamespaceType option -> ParsedImplFileInput -> Eventually val TypeCheckOneSigFile : - TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink + TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink * bool -> TcEnv -> ParsedSigFileInput -> Eventually diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.cs.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.cs.xlf index 2567d3f26f..d4667e04c0 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.cs.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.cs.xlf @@ -264,7 +264,7 @@ Prevents references from being locked by the F# Interactive process - Znemožňuje zamknutí referencí interaktivním procesem jazyka F#. + Znemožňuje zamknutí referencí procesem nástroje F# Interactive. diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.de.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.de.xlf index ec345eadd3..f87d3361f2 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.de.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.de.xlf @@ -264,7 +264,7 @@ Prevents references from being locked by the F# Interactive process - Verhindert, dass Verweise vom interaktiven Prozess F# gesperrt werden + Verhindert, dass Verweise vom F# Interactive-Prozess gesperrt werden diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.es.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.es.xlf index a43b278bb1..6af67db255 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.es.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.es.xlf @@ -99,7 +99,7 @@ A problem occurred starting the F# Interactive process. This may be due to a known problem with background process console support for Unicode-enabled applications on some Windows systems. Try selecting Tools->Options->F# Interactive for Visual Studio and enter '--fsi-server-no-unicode'. - Se produjo un problema al iniciar el proceso de F# interactivo. Esto puede deberse a un problema conocido de compatibilidad de la consola de procesos en segundo plano con aplicaciones habilitadas para Unicode en algunos sistemas Windows. Pruebe lo siguiente: seleccione Herramientas->Opciones->F# interactivo para Visual Studio y escriba '--fsi-server-no-unicode'. + Se produjo un problema al iniciar el proceso de F# interactivo. Esto puede deberse a un problema conocido de compatibilidad de la consola de procesos en segundo plano con aplicaciones habilitadas para Unicode en algunos sistemas Windows. Pruebe lo siguiente: seleccione Herramientas->Opciones->F# interactivo para Visual Studio y escriba “--fsi-server-no-unicode”. @@ -139,7 +139,7 @@ F# Interactive directives: - Directivas de F#: + Directivas de F# interactivo: @@ -214,7 +214,7 @@ --> Referenced '{0}' (file may be locked by F# Interactive process) - --> '{0}' al que se hace referencia (el archivo puede estar bloqueado por un proceso de F# interactivo) + --> “{0}” al que se hace referencia (el archivo puede estar bloqueado por un proceso de F# interactivo) @@ -259,7 +259,7 @@ F# Interactive for F# {0} - F# Interactive para F# {0} + F# interactivo para F# {0} diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.fr.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.fr.xlf index 4343c88666..917a17f435 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.fr.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.fr.xlf @@ -264,7 +264,7 @@ Prevents references from being locked by the F# Interactive process - Empêche le blocage des références par le processus interactif F# + Empêche le blocage des références par le processus de F# Interactive diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.it.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.it.xlf index bdba37d1c7..d7f05d6aa9 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.it.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.it.xlf @@ -114,7 +114,7 @@ Invalid directive '#{0} {1}' - Direttiva non valida '#{0} {1}' + Direttiva '#{0} {1}' non valida diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.ja.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.ja.xlf index 8697e6da83..0751b4601e 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.ja.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.ja.xlf @@ -99,7 +99,7 @@ A problem occurred starting the F# Interactive process. This may be due to a known problem with background process console support for Unicode-enabled applications on some Windows systems. Try selecting Tools->Options->F# Interactive for Visual Studio and enter '--fsi-server-no-unicode'. - F# Interactive のプロセスの開始中に問題が発生しました。この原因は、一部の Windows システム上での Unicode 対応アプリケーションのバックグラウンド プロセス コンソールのサポートに関する既知の問題にある可能性があります。[ツール]5D; の [オプション]5D; から [F# Interactive for Visual Studio]5D; を選択し、「--fsi-server-no-unicode」と入力してください。 + F# インタラクティブのプロセスの開始中に問題が発生しました。この原因は、一部の Windows システム上での Unicode 対応アプリケーションのバックグラウンド プロセス コンソールのサポートに関する既知の問題にある可能性があります。[ツール]5D; の [オプション]5D; から [F# Interactive for Visual Studio]5D; を選択し、「--fsi-server-no-unicode」と入力してください。 @@ -139,7 +139,7 @@ F# Interactive directives: - F# Interactive ディレクティブ: + F# インタラクティブ ディレクティブ: @@ -174,7 +174,7 @@ F# Interactive command line options: - F# Interactive コマンド ライン オプション: + F# インタラクティブ コマンド ライン オプション: @@ -214,7 +214,7 @@ --> Referenced '{0}' (file may be locked by F# Interactive process) - --> '{0}' を参照しました (ファイルが F# Interactive のプロセスによってロックされている可能性があります) + --> '{0}' を参照しました (ファイルが F# インタラクティブのプロセスによってロックされている可能性があります) @@ -254,17 +254,17 @@ Microsoft (R) F# Interactive version {0} - Microsoft (R) F# Interactive Version {0} + Microsoft (R) F# インタラクティブ バージョン {0} F# Interactive for F# {0} - F# {0} の F# Interactive + F# {0} の F# インタラクティブ Prevents references from being locked by the F# Interactive process - 参照が F# 対話型プロセスによってロックされないようにします。 + 参照が F# インタラクティブ プロセスによってロックされないようにします。 diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.ko.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.ko.xlf index 6f6d927ebf..69a5d3b535 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.ko.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.ko.xlf @@ -99,7 +99,7 @@ A problem occurred starting the F# Interactive process. This may be due to a known problem with background process console support for Unicode-enabled applications on some Windows systems. Try selecting Tools->Options->F# Interactive for Visual Studio and enter '--fsi-server-no-unicode'. - F# Interactive 프로세스를 시작하는 동안 오류가 발생했습니다. 일부 Windows 시스템에서 나타나는 유니코드 기반 응용 프로그램의 백그라운드 프로세스 콘솔 지원과 관련된 알려진 문제가 원인일 수 있습니다. [도구]5D;->[옵션]5D;->[F# Interactive for Visual Studio]5D;를 선택하고 '--fsi-server-no-unicode'를 입력해 보세요. + F# 대화형 프로세스를 시작하는 동안 오류가 발생했습니다. 일부 Windows 시스템에서 나타나는 유니코드 기반 응용 프로그램의 백그라운드 프로세스 콘솔 지원과 관련된 알려진 문제가 원인일 수 있습니다. [도구]5D;->[옵션]5D;->[Visual Studio용 F# 대화형]5D;를 선택하고 '--fsi-server-no-unicode'를 입력해 보세요. @@ -139,7 +139,7 @@ F# Interactive directives: - F# Interactive 지시문: + F# 대화형 지시문: @@ -174,7 +174,7 @@ F# Interactive command line options: - F# Interactive 명령줄 옵션: + F# 대화형 명령줄 옵션: @@ -214,7 +214,7 @@ --> Referenced '{0}' (file may be locked by F# Interactive process) - --> '{0}' 참조됨(파일은 F# Interactive 프로세스에 의해 잠길 수 있음) + --> '{0}' 참조됨(파일은 F# 대화형 프로세스에 의해 잠길 수 있음) @@ -254,17 +254,17 @@ Microsoft (R) F# Interactive version {0} - Microsoft (R) F# Interactive 버전 {0} + Microsoft (R) F# 대화형 버전 {0} F# Interactive for F# {0} - F# {0}에 대한 F# Interactive + F# {0}에 대한 F# 대화형 Prevents references from being locked by the F# Interactive process - 참조가 F# Interactive 프로세스에 의해 잠기지 않도록 합니다. + 참조가 F# 대화형 프로세스에 의해 잠기지 않도록 합니다. diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.pt-BR.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.pt-BR.xlf index 7d8838f24f..d35388b4cb 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.pt-BR.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.pt-BR.xlf @@ -99,7 +99,7 @@ A problem occurred starting the F# Interactive process. This may be due to a known problem with background process console support for Unicode-enabled applications on some Windows systems. Try selecting Tools->Options->F# Interactive for Visual Studio and enter '--fsi-server-no-unicode'. - Um problema ocorreu na inicialização do processo interativo #F. Isto pode ter ocorrido devido a um problema conhecido com processo de fundo do console de apoio pelo aplicativos habilitados Unicode em alguns sistemas do Windows. Tente Ferramentas->Opções->Interativo F# para Visual Studio e insira '--fsi-server-no-unicode'. + Um problema ocorreu na inicialização do processo F# Interativo. Isto pode ter ocorrido devido a um problema conhecido com processo de fundo do console de apoio pelo aplicativos habilitados Unicode em alguns sistemas do Windows. Tente Ferramentas->Opções->F# Interativo para Visual Studio e insira '--fsi-server-no-unicode'. @@ -139,7 +139,7 @@ F# Interactive directives: - Diretrizes interativas F#: + Diretrizes F# Interativo: @@ -174,7 +174,7 @@ F# Interactive command line options: - Opções de linha de comando F# interativo: + Opções de linha de comando F# Interativo: @@ -254,7 +254,7 @@ Microsoft (R) F# Interactive version {0} - Microsoft (R) F# Interactive versão {0} + Microsoft (R) F# Interativo versão {0} @@ -264,7 +264,7 @@ Prevents references from being locked by the F# Interactive process - Impede que as referências sejam bloqueadas pelo processo de F# interativo + Impede que as referências sejam bloqueadas pelo processo de F# Interativo diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.ru.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.ru.xlf index 1d6ce4e963..6e40ee07dd 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.ru.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.ru.xlf @@ -99,7 +99,7 @@ A problem occurred starting the F# Interactive process. This may be due to a known problem with background process console support for Unicode-enabled applications on some Windows systems. Try selecting Tools->Options->F# Interactive for Visual Studio and enter '--fsi-server-no-unicode'. - Возникла проблема при запуске процесса F# Interactive. Это может быть вызвано известной проблемой с поддержкой консоли фонового процесса для приложений с поддержкой Юникода в некоторых системах Windows. Попробуйте выбрать "Сервис->Параметры->F# Interactive для Visual Studio" и ввести "--fsi-server-no-unicode". + Возникла проблема при запуске процесса F# Interactive. Это может быть вызвано известной проблемой с поддержкой консоли фонового процесса для приложений с поддержкой Юникода в некоторых системах Windows. Попробуйте выбрать "Сервис" -> "Параметры" -> "F# Interactive для Visual Studio" и ввести "--fsi-server-no-unicode". @@ -264,7 +264,7 @@ Prevents references from being locked by the F# Interactive process - Предотвращает блокировку ссылок интерактивным процессом F#. + Предотвращает блокировку ссылок процессом F# Interactive. diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.tr.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.tr.xlf index 7393283389..6497500a1f 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.tr.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.tr.xlf @@ -99,7 +99,7 @@ A problem occurred starting the F# Interactive process. This may be due to a known problem with background process console support for Unicode-enabled applications on some Windows systems. Try selecting Tools->Options->F# Interactive for Visual Studio and enter '--fsi-server-no-unicode'. - F# Interactive işlemi başlatılırken bir sorun oluştu. Bu durum, bazı Windows sistemlerindeki Unicode kullanan uygulamalara yönelik arka plan işlemi konsol desteğinde bilinen bir soruna bağlı olabilir. Visual Studio için Araçlar->Seçenekler->F# Interactive'i seçmeyi deneyin ve '--fsi-server-no-unicode' girin. + F# Etkileşimli işlemi başlatılırken bir sorun oluştu. Bu durum, bazı Windows sistemlerindeki Unicode kullanan uygulamalara yönelik arka plan işlemi konsol desteğinde bilinen bir soruna bağlı olabilir. Visual Studio için Araçlar->Seçenekler->F# Etkileşimli'yi seçmeyi deneyin ve '--fsi-server-no-unicode' girin. @@ -139,7 +139,7 @@ F# Interactive directives: - F# Interactive yönergeleri: + F# Etkileşimli yönergeleri: @@ -174,7 +174,7 @@ F# Interactive command line options: - F# Interactive komut satırı seçenekleri: + F# Etkileşimli komut satırı seçenekleri: @@ -214,7 +214,7 @@ --> Referenced '{0}' (file may be locked by F# Interactive process) - --> '{0}' öğesine başvuruldu (dosya F# Interactive işlemi tarafından kilitlenmiş olabilir) + --> '{0}' öğesine başvuruldu (dosya F# Etkileşimli işlemi tarafından kilitlenmiş olabilir) @@ -254,12 +254,12 @@ Microsoft (R) F# Interactive version {0} - Microsoft (R) F# Interactive sürüm {0} + Microsoft (R) F# Etkileşimli sürüm {0} F# Interactive for F# {0} - F# {0} için F# Interactive + F# {0} için F# Etkileşimli diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.zh-Hans.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.zh-Hans.xlf index 317abba3c1..6089715c68 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.zh-Hans.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.zh-Hans.xlf @@ -99,7 +99,7 @@ A problem occurred starting the F# Interactive process. This may be due to a known problem with background process console support for Unicode-enabled applications on some Windows systems. Try selecting Tools->Options->F# Interactive for Visual Studio and enter '--fsi-server-no-unicode'. - 启动 F# 交互进程时发生问题。此情况可能是由一个已知问题导致的，即某些 Windows 系统上的后台进程控制台不支持启用了 Unicode 的应用程序。请尝试选择“工具”->“选项”->“F# 交互 for Visual Studio”，然后输入“--fsi-server-no-unicode”。 + 启动 F# 交互窗口进程时发生问题。此情况可能是由一个已知问题导致的，即某些 Windows 系统上的后台进程控制台不支持启用了 Unicode 的应用程序。请尝试选择“工具”->“选项”->“适用于 Visual Studio 的 F# 交互窗口”，然后输入“--fsi-server-no-unicode”。 @@ -139,7 +139,7 @@ F# Interactive directives: - F# 交互指令: + F# 交互窗口指令: @@ -174,7 +174,7 @@ F# Interactive command line options: - F# 交互命令行选项: + F# 交互窗口命令行选项: @@ -214,7 +214,7 @@ --> Referenced '{0}' (file may be locked by F# Interactive process) - --> 已引用“{0}”(文件可能由 F# 交互进程锁定) + --> 已引用“{0}”(文件可能由 F# 交互窗口进程锁定) @@ -254,7 +254,7 @@ Microsoft (R) F# Interactive version {0} - Microsoft(R) F# 交互版本 {0} + Microsoft(R) F# 交互窗口版本 {0} @@ -264,7 +264,7 @@ Prevents references from being locked by the F# Interactive process - 防止引用被 F# 交互式进程锁定 + 防止引用被 F# 交互窗口进程锁定 diff --git a/src/fsharp/fsi/xlf/FSIstrings.txt.zh-Hant.xlf b/src/fsharp/fsi/xlf/FSIstrings.txt.zh-Hant.xlf index 84501a17e1..1752c12240 100644 --- a/src/fsharp/fsi/xlf/FSIstrings.txt.zh-Hant.xlf +++ b/src/fsharp/fsi/xlf/FSIstrings.txt.zh-Hant.xlf @@ -99,7 +99,7 @@ A problem occurred starting the F# Interactive process. This may be due to a known problem with background process console support for Unicode-enabled applications on some Windows systems. Try selecting Tools->Options->F# Interactive for Visual Studio and enter '--fsi-server-no-unicode'. - 啟動 F# Interactive 處理序時發生問題。這可能是因為背景處理序主控台對於支援某些 Windows 系統上具備 Unicode 支援功能之應用程式的已知問題所造成。請嘗試選取 [工具]5D; -> [選項]5D; -> [F# Interactive for Visual Studio]5D;，然後輸入 '--fsi-server-no-unicode'。 + 啟動 F# 互動處理序時發生問題。這可能是因為背景處理序主控台對於支援某些 Windows 系統上具備 Unicode 支援功能之應用程式的已知問題所造成。請嘗試選取 [工具]5D; -> [選項]5D; -> [F# Interactive for Visual Studio]5D;，然後輸入 '--fsi-server-no-unicode'。 @@ -139,7 +139,7 @@ F# Interactive directives: - F# Interactive 指示詞: + F# 互動指示詞: @@ -174,7 +174,7 @@ F# Interactive command line options: - F# Interactive 命令列選項: + F# 互動命令列選項: @@ -214,7 +214,7 @@ --> Referenced '{0}' (file may be locked by F# Interactive process) - --> 參考的 '{0}' (檔案可能已被 F# Interactive 處理序鎖定) + --> 參考的 '{0}' (檔案可能已被 F# 互動處理序鎖定) @@ -254,17 +254,17 @@ Microsoft (R) F# Interactive version {0} - Microsoft (R) F# Interactive 版本 {0} + Microsoft (R) F# 互動版本 {0} F# Interactive for F# {0} - 適用於 F# {0} 的 F# Interactive + 適用於 F# {0} 的 F# 互動 Prevents references from being locked by the F# Interactive process - 避免參考遭 F# 互動式處理序封鎖 + 避免參考遭 F# 互動處理序封鎖 diff --git a/src/fsharp/service/ServiceDeclarationLists.fs b/src/fsharp/service/ServiceDeclarationLists.fs index 838d221ead..85d7249f61 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fs +++ b/src/fsharp/service/ServiceDeclarationLists.fs @@ -615,15 +615,23 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[], isForT | None -> item.Item.DisplayName name, items) - // Filter out operators (and list) + // Filter out operators, active patterns (as values) and the empty list let items = // Check whether this item looks like an operator. let isOperatorItem(name, items: CompletionItem list) = match items |> List.map (fun x -> x.Item) with | [Item.Value _ | Item.MethodGroup _ | Item.UnionCase _] -> IsOperatorName name | _ -> false - let isFSharpList name = (name = "[]") // list shows up as a Type and a UnionCase, only such entity with a symbolic name, but want to filter out of intellisense - items |> List.filter (fun (displayName, items) -> not (isOperatorItem(displayName, items)) && not (isFSharpList displayName)) + + let isActivePatternItem (items: CompletionItem list) = + match items |> List.map (fun x -> x.Item) with + | [Item.Value vref] -> IsActivePatternName vref.CompiledName + | _ -> false + + items |> List.filter (fun (displayName, items) -> + not (isOperatorItem(displayName, items)) && + not (displayName = "[]") && // list shows up as a Type and a UnionCase, only such entity with a symbolic name, but want to filter out of intellisense + not (isActivePatternItem items)) let decls = items diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index a8eb0bfed2..7f94652a18 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -83,8 +83,8 @@ module public AstTraversal = abstract VisitComponentInfo : SynComponentInfo -> 'T option default this.VisitComponentInfo (_) = None /// VisitLetOrUse allows overriding behavior when visiting module or local let or use bindings - abstract VisitLetOrUse : SynBinding list * range -> 'T option - default this.VisitLetOrUse (_, _) = None + abstract VisitLetOrUse : TraversePath * (SynBinding -> 'T option) * SynBinding list * range -> 'T option + default this.VisitLetOrUse (_, _, _, _) = None /// VisitType allows overriding behavior when visiting simple pats abstract VisitSimplePats : SynSimplePat list -> 'T option default this.VisitSimplePats (_) = None @@ -158,7 +158,7 @@ module public AstTraversal = | SynModuleDecl.ModuleAbbrev(_ident, _longIdent, _range) -> None | SynModuleDecl.NestedModule(_synComponentInfo, _isRec, synModuleDecls, _, _range) -> synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick decl | SynModuleDecl.Let(_, synBindingList, range) -> - match visitor.VisitLetOrUse(synBindingList, range) with + match visitor.VisitLetOrUse(path, traverseSynBinding path, synBindingList, range) with | Some x -> Some x | None -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingAndRhs (traverseSynBinding path)) |> pick decl | SynModuleDecl.DoExpr(_sequencePointInfoForBinding, synExpr, _range) -> traverseSynExpr path synExpr @@ -364,7 +364,7 @@ module public AstTraversal = |> pick expr | SynExpr.TypeApp(synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr | SynExpr.LetOrUse(_, _, synBindingList, synExpr, range) -> - match visitor.VisitLetOrUse(synBindingList, range) with + match visitor.VisitLetOrUse(path, traverseSynBinding path, synBindingList, range) with | Some x -> Some x | None -> [yield! synBindingList |> List.map (fun x -> dive x x.RangeOfBindingAndRhs (traverseSynBinding path)) @@ -586,7 +586,7 @@ module public AstTraversal = ] |> pick m | SynMemberDefn.AutoProperty(_attribs, _isStatic, _id, _tyOpt, _propKind, _, _xmlDoc, _access, synExpr, _, _) -> traverseSynExpr path synExpr | SynMemberDefn.LetBindings(synBindingList, _, _, range) -> - match visitor.VisitLetOrUse(synBindingList, range) with + match visitor.VisitLetOrUse(path, traverseSynBinding path, synBindingList, range) with | Some x -> Some x | None -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingAndRhs (traverseSynBinding path)) |> pick m | SynMemberDefn.AbstractSlot(_synValSig, _memberFlags, _range) -> None diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index 397e6f604b..18cb8023de 100755 --- a/src/fsharp/service/ServiceUntypedParse.fs +++ b/src/fsharp/service/ServiceUntypedParse.fs @@ -1289,7 +1289,7 @@ module UntypedParseImpl = if rangeContainsPos range pos then Some CompletionContext.Invalid else None - member __.VisitLetOrUse(bindings, range) = + member __.VisitLetOrUse(_, _, bindings, range) = match bindings with | [] when range.StartLine = pos.Line -> Some CompletionContext.Invalid | _ -> None diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 34e2e9d2d5..5ecc71684c 100755 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -577,6 +577,7 @@ type TypeCheckInfo | Item.Event _ -> CompletionItemKind.Event | Item.ILField _ | Item.Value _ -> CompletionItemKind.Field + | Item.CustomOperation _ -> CompletionItemKind.CustomOperation | _ -> CompletionItemKind.Other { ItemWithInst = item @@ -902,6 +903,9 @@ type TypeCheckInfo match item with | Item.Types _ | Item.ModuleOrNamespaces _ -> true | _ -> false + + /// Find the most precise display context for the given line and column. + member __.GetBestDisplayEnvForPos cursorPos = GetBestEnvForPos cursorPos member __.GetVisibleNamespacesAndModulesAtPosition(cursorPos: pos) : ModuleOrNamespaceRef list = let (nenv, ad), m = GetBestEnvForPos cursorPos @@ -2015,6 +2019,7 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp | _ -> async.Return dflt + member info.GetToolTipText(line, colAtEndOfNames, lineStr, names, tokenTag, userOpName) = info.GetStructuredToolTipText(line, colAtEndOfNames, lineStr, names, tokenTag, ?userOpName=userOpName) |> Tooltips.Map Tooltips.ToFSharpToolTipText @@ -2127,6 +2132,13 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp RequireCompilationThread ctok scope.IsRelativeNameResolvableFromSymbol(pos, plid, symbol)) + member info.GetDisplayEnvForPos(pos: pos) : Async = + let userOpName = "CodeLens" + reactorOp userOpName "GetDisplayContextAtPos" None (fun ctok scope -> + DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok + let (nenv, _), _ = scope.GetBestDisplayEnvForPos pos + Some nenv.DisplayEnv) + member info.ImplementationFile = if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" scopeOptX diff --git a/src/fsharp/service/service.fsi b/src/fsharp/service/service.fsi index ec80a76d9d..5ccb31e450 100755 --- a/src/fsharp/service/service.fsi +++ b/src/fsharp/service/service.fsi @@ -240,6 +240,9 @@ type public FSharpCheckFileResults = member internal GetVisibleNamespacesAndModulesAtPoint : pos -> Async + /// Find the most precise display environment for the given line and column. + member internal GetDisplayEnvForPos : pos : pos -> Async + /// Determines if a long ident is resolvable at a specific point. /// An optional string used for tracing compiler operations associated with this request. member internal IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item * ?userOpName: string -> Async diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index f7450623ec..2a3031e004 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -275,6 +275,7 @@ type CompletionItemKind = | Method of isExtension : bool | Event | Argument + | CustomOperation | Other type UnresolvedSymbol = diff --git a/src/fsharp/symbols/SymbolHelpers.fsi b/src/fsharp/symbols/SymbolHelpers.fsi index 03d62d4aec..cbc351baf5 100755 --- a/src/fsharp/symbols/SymbolHelpers.fsi +++ b/src/fsharp/symbols/SymbolHelpers.fsi @@ -113,6 +113,7 @@ type public CompletionItemKind = | Method of isExtension : bool | Event | Argument + | CustomOperation | Other type UnresolvedSymbol = diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 4ce77c11ef..fc57dedae9 100755 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -123,6 +123,7 @@ module Impl = /// Convert an IL member accessibility into an F# accessibility let getApproxFSharpAccessibilityOfMember (declaringEntity: EntityRef) (ilAccess: ILMemberAccess) = match ilAccess with + | ILMemberAccess.CompilerControlled | ILMemberAccess.FamilyAndAssembly | ILMemberAccess.Assembly -> taccessPrivate (CompPath(declaringEntity.CompilationPath.ILScopeRef, [])) @@ -1958,6 +1959,23 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = prefix + x.LogicalName with _ -> "??" + member x.FormatLayout (denv:FSharpDisplayContext) = + match x.IsMember, d with + | true, V v -> + NicePrint.prettyLayoutOfValOrMemberNoInst { (denv.Contents cenv.g) with showMemberContainers=true } v.Deref + | _,_ -> + checkIsResolved() + let ty = + match d with + | E e -> e.GetDelegateType(cenv.amap, range0) + | P p -> p.GetPropertyType(cenv.amap, range0) + | M m | C m -> + let rty = m.GetFSharpReturnTy(cenv.amap, range0, m.FormalMethodInst) + let argtysl = m.GetParamTypes(cenv.amap, range0, m.FormalMethodInst) + mkIteratedFunTy (List.map (mkRefTupledTy cenv.g) argtysl) rty + | V v -> v.TauType + NicePrint.prettyLayoutOfTypeNoCx (denv.Contents cenv.g) ty + and FSharpType(cenv, ty:TType) = @@ -2105,6 +2123,10 @@ and FSharpType(cenv, ty:TType) = protect <| fun () -> NicePrint.prettyStringOfTyNoCx (denv.Contents cenv.g) ty + member x.FormatLayout(denv: FSharpDisplayContext) = + protect <| fun () -> + NicePrint.prettyLayoutOfTypeNoCx (denv.Contents cenv.g) ty + override x.ToString() = protect <| fun () -> "type " + NicePrint.prettyStringOfTyNoCx (DisplayEnv.Empty(cenv.g)) ty diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index 458495fbf4..7b7f565fdc 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -825,6 +825,9 @@ and [] public FSharpMemberOrFunctionOrValue = /// Indicates if this is a constructor. member IsConstructor : bool + + /// Format the type using the rules of the given display context + member FormatLayout : context: FSharpDisplayContext -> Layout /// A subtype of FSharpSymbol that represents a parameter @@ -940,6 +943,9 @@ and [] public FSharpType = /// Format the type using the rules of the given display context member Format : context: FSharpDisplayContext -> string + /// Format the type using the rules of the given display context + member FormatLayout : context: FSharpDisplayContext -> Layout + /// Instantiate generic type parameters in a type member Instantiate : (FSharpGenericParameter * FSharpType) list -> FSharpType diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index ffef5fc82b..27130dc085 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -314,73 +314,84 @@ type TyparRigidity = type TyparFlags(flags:int32) = new (kind:TyparKind, rigidity:TyparRigidity, isFromError:bool, isCompGen:bool, staticReq:TyparStaticReq, dynamicReq:TyparDynamicReq, equalityDependsOn: bool, comparisonDependsOn: bool) = - TyparFlags((if isFromError then 0b0000000000010 else 0) ||| - (if isCompGen then 0b0000000000100 else 0) ||| + TyparFlags((if isFromError then 0b00000000000000010 else 0) ||| + (if isCompGen then 0b00000000000000100 else 0) ||| (match staticReq with - | NoStaticReq -> 0b0000000000000 - | HeadTypeStaticReq -> 0b0000000001000) ||| + | NoStaticReq -> 0b00000000000000000 + | HeadTypeStaticReq -> 0b00000000000001000) ||| (match rigidity with - | TyparRigidity.Rigid -> 0b0000000000000 - | TyparRigidity.WillBeRigid -> 0b0000000100000 - | TyparRigidity.WarnIfNotRigid -> 0b0000001000000 - | TyparRigidity.Flexible -> 0b0000001100000 - | TyparRigidity.Anon -> 0b0000010000000) ||| + | TyparRigidity.Rigid -> 0b00000000000000000 + | TyparRigidity.WillBeRigid -> 0b00000000000100000 + | TyparRigidity.WarnIfNotRigid -> 0b00000000001000000 + | TyparRigidity.Flexible -> 0b00000000001100000 + | TyparRigidity.Anon -> 0b00000000010000000) ||| (match kind with - | TyparKind.Type -> 0b0000000000000 - | TyparKind.Measure -> 0b0000100000000) ||| + | TyparKind.Type -> 0b00000000000000000 + | TyparKind.Measure -> 0b00000000100000000) ||| (if comparisonDependsOn then - 0b0001000000000 else 0) ||| + 0b00000001000000000 else 0) ||| (match dynamicReq with - | TyparDynamicReq.No -> 0b0000000000000 - | TyparDynamicReq.Yes -> 0b0010000000000) ||| + | TyparDynamicReq.No -> 0b00000000000000000 + | TyparDynamicReq.Yes -> 0b00000010000000000) ||| (if equalityDependsOn then - 0b0100000000000 else 0)) + 0b00000100000000000 else 0)) /// Indicates if the type inference variable was generated after an error when type checking expressions or patterns - member x.IsFromError = (flags &&& 0b0000000000010) <> 0x0 + member x.IsFromError = (flags &&& 0b00000000000000010) <> 0x0 /// Indicates if the type variable is compiler generated, i.e. is an implicit type inference variable - member x.IsCompilerGenerated = (flags &&& 0b0000000000100) <> 0x0 + member x.IsCompilerGenerated = (flags &&& 0b00000000000000100) <> 0x0 /// Indicates if the type variable has a static "head type" requirement, i.e. ^a variables used in FSharp.Core and member constraints. member x.StaticReq = - match (flags &&& 0b0000000001000) with - | 0b0000000000000 -> NoStaticReq - | 0b0000000001000 -> HeadTypeStaticReq + match (flags &&& 0b00000000000001000) with + | 0b00000000000000000 -> NoStaticReq + | 0b00000000000001000 -> HeadTypeStaticReq | _ -> failwith "unreachable" /// Indicates if the type variable can be solved or given new constraints. The status of a type variable /// generally always evolves towards being either rigid or solved. member x.Rigidity = - match (flags &&& 0b0000011100000) with - | 0b0000000000000 -> TyparRigidity.Rigid - | 0b0000000100000 -> TyparRigidity.WillBeRigid - | 0b0000001000000 -> TyparRigidity.WarnIfNotRigid - | 0b0000001100000 -> TyparRigidity.Flexible - | 0b0000010000000 -> TyparRigidity.Anon + match (flags &&& 0b00000000011100000) with + | 0b00000000000000000 -> TyparRigidity.Rigid + | 0b00000000000100000 -> TyparRigidity.WillBeRigid + | 0b00000000001000000 -> TyparRigidity.WarnIfNotRigid + | 0b00000000001100000 -> TyparRigidity.Flexible + | 0b00000000010000000 -> TyparRigidity.Anon | _ -> failwith "unreachable" /// Indicates whether a type variable can be instantiated by types or units-of-measure. member x.Kind = - match (flags &&& 0b1000100000000) with - | 0b0000000000000 -> TyparKind.Type - | 0b0000100000000 -> TyparKind.Measure + match (flags &&& 0b00001000100000000) with + | 0b00000000000000000 -> TyparKind.Type + | 0b00000000100000000 -> TyparKind.Measure | _ -> failwith "unreachable" /// Indicates that whether or not a generic type definition satisfies the comparison constraint is dependent on whether this type variable satisfies the comparison constraint. member x.ComparisonConditionalOn = - (flags &&& 0b0001000000000) <> 0x0 + (flags &&& 0b00000001000000000) <> 0x0 + /// Indicates if a type parameter is needed at runtime and may not be eliminated member x.DynamicReq = - match (flags &&& 0b0010000000000) with - | 0b0000000000000 -> TyparDynamicReq.No - | 0b0010000000000 -> TyparDynamicReq.Yes + match (flags &&& 0b00000010000000000) with + | 0b00000000000000000 -> TyparDynamicReq.No + | 0b00000010000000000 -> TyparDynamicReq.Yes | _ -> failwith "unreachable" + /// Indicates that whether or not a generic type definition satisfies the equality constraint is dependent on whether this type variable satisfies the equality constraint. member x.EqualityConditionalOn = - (flags &&& 0b0100000000000) <> 0x0 + (flags &&& 0b00000100000000000) <> 0x0 + + /// Indicates that whether this type parameter is a compat-flex type parameter (i.e. where "expr :> tp" only emits an optional warning) + member x.IsCompatFlex = + (flags &&& 0b00010000000000000) <> 0x0 + member x.WithCompatFlex(b) = + if b then + TyparFlags(flags ||| 0b00010000000000000) + else + TyparFlags(flags &&& ~~~0b00010000000000000) /// Get the flags as included in the F# binary metadata. We pickle this as int64 to allow for future expansion member x.PickledBits = flags @@ -2162,6 +2173,12 @@ and /// Indicates if the type inference variable was generated after an error when type checking expressions or patterns member x.IsFromError = x.typar_flags.IsFromError + /// Indicates that whether this type parameter is a compat-flex type parameter (i.e. where "expr :> tp" only emits an optional warning) + member x.IsCompatFlex = x.typar_flags.IsCompatFlex + + /// Set whether this type parameter is a compat-flex type parameter (i.e. where "expr :> tp" only emits an optional warning) + member x.SetIsCompatFlex(b) = x.typar_flags <- x.typar_flags.WithCompatFlex(b) + /// Indicates whether a type variable can be instantiated by types or units-of-measure. member x.Kind = x.typar_flags.Kind diff --git a/src/utils/CompilerLocationUtils.fs b/src/utils/CompilerLocationUtils.fs index 9bfcbf3fc2..3499e7e5b2 100755 --- a/src/utils/CompilerLocationUtils.fs +++ b/src/utils/CompilerLocationUtils.fs @@ -12,7 +12,7 @@ open System.Runtime.InteropServices module internal FSharpEnvironment = /// The F# version reported in the banner - let FSharpBannerVersion = "10.1.0 for F# 4.1" + let FSharpBannerVersion = "10.2.3 for F# 4.5" let versionOf<'t> = #if FX_RESHAPED_REFLECTION @@ -217,31 +217,13 @@ module internal FSharpEnvironment = match probePoint with | Some p when safeExists (Path.Combine(p,"FSharp.Core.dll")) -> Some p | _ -> - - // On windows the location of the compiler is via a registry key - - // Note: If the keys below change, be sure to update code in: - // Property pages (ApplicationPropPage.vb) - let keys = - [| - @"Software\Microsoft\FSharp\10.1\Runtime\v4.0"; - @"Software\Microsoft\FSharp\4.1\Runtime\v4.0"; - @"Software\Microsoft\FSharp\4.0\Runtime\v4.0" - |] - let path = keys |> Seq.tryPick(fun k -> tryRegKey k) - match path with - | Some _ -> path - | None -> - // On Unix we let you set FSHARP_COMPILER_BIN. I've rarely seen this used and its not documented in the install instructions. - let result = - let var = System.Environment.GetEnvironmentVariable("FSHARP_COMPILER_BIN") - if String.IsNullOrEmpty(var) then None - else Some(var) - match result with - | Some _ -> result - | None -> - // For the prototype compiler, we can just use the current domain - tryCurrentDomain() + // We let you set FSHARP_COMPILER_BIN. I've rarely seen this used and its not documented in the install instructions. + let result = System.Environment.GetEnvironmentVariable("FSHARP_COMPILER_BIN") + if not (String.IsNullOrEmpty(result)) then + Some result + else + // For the prototype compiler, we can just use the current domain + tryCurrentDomain() with e -> System.Diagnostics.Debug.Assert(false, "Error while determining default location of F# compiler") None diff --git a/tests/service/MultiProjectAnalysisTests.fs b/tests/service/MultiProjectAnalysisTests.fs index 43867d7388..0e4d38a332 100644 --- a/tests/service/MultiProjectAnalysisTests.fs +++ b/tests/service/MultiProjectAnalysisTests.fs @@ -931,6 +931,8 @@ let ``Type provider project references should not throw exceptions`` () = [] #if NETCOREAPP2_0 [] +#else +[] #endif let ``Projects creating generated types should not utilize cross-project-references but should still analyze oK once project is built`` () = //let options = ProjectCracker.GetProjectOptionsFromProjectFile(projectFile, [("Configuration", "Debug")]) @@ -1018,7 +1020,4 @@ let ``Projects creating generated types should not utilize cross-project-referen printfn "Errors: %A" fileCheckResults.Errors fileCheckResults.Errors |> Array.exists (fun error -> error.Severity = FSharpErrorSeverity.Error) |> shouldEqual false - - - //------------------------------------------------------------------------------------ diff --git a/tests/service/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.dll b/tests/service/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.dll index 8e73750a86..1ef8b4ae87 100644 Binary files a/tests/service/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.dll and b/tests/service/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.dll differ diff --git a/tests/service/data/samename/tempet.fsproj b/tests/service/data/samename/tempet.fsproj index 8e647890c8..682a3ec1a3 100644 --- a/tests/service/data/samename/tempet.fsproj +++ b/tests/service/data/samename/tempet.fsproj @@ -1,4 +1,4 @@ - + netstandard1.6 @@ -6,8 +6,4 @@ - - - - \ No newline at end of file