diff --git a/.travis.yml b/.travis.yml index 22acb82a11..94ef8462d4 100644 --- a/.travis.yml +++ b/.travis.yml @@ -9,9 +9,9 @@ osx_image: xcode11.2 mono: - weekly - latest - - 6.0.0 + - 6.6.0 -dotnet: 3.0.100 +dotnet: 3.1.100 sudo: false diff --git a/eng/DumpPackageRoot/DumpPackageRoot.csproj b/eng/DumpPackageRoot/DumpPackageRoot.csproj new file mode 100644 index 0000000000..c3b2cedf8f --- /dev/null +++ b/eng/DumpPackageRoot/DumpPackageRoot.csproj @@ -0,0 +1,22 @@ + + + + + + netcoreapp3.1 + + + + + + + + + $(ArtifactsDir)NugetPackageRootContents + $(PackageRootArtifactDirectory)/package_contents.txt + + + + + diff --git a/eng/Version.Details.xml b/eng/Version.Details.xml index c98fbfbee4..32d8984d89 100644 --- a/eng/Version.Details.xml +++ b/eng/Version.Details.xml @@ -3,9 +3,9 @@ - + https://github.com/dotnet/arcade - d0833c8e5e58cfc507ce3c8da364e55931190263 + 69a67461460d99125742d5c2dd94dad83add84a3 diff --git a/eng/Versions.props b/eng/Versions.props index 1ee1522072..5b0f95663e 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -183,7 +183,7 @@ 3.11.0 3.11.2 3.11.0 - 2.1.36 + 2.1.41 1.0.0-beta2-dev3 5.28.0.1 2.0.187 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 874bb28070..316577d6d9 100644 --- a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -1,5 +1,6 @@ + $(FcsTargetNetFxFramework);netcoreapp3.0 true @@ -66,6 +67,9 @@ TreeVisitorTests.fs + + ScriptOptionsTests.fs + Program.fs @@ -77,10 +81,10 @@ - - - + + + diff --git a/fcs/FSharp.Compiler.Service.Tests/FsxCompletionProviderTests.fs b/fcs/FSharp.Compiler.Service.Tests/FsxCompletionProviderTests.fs index 468c916dc9..236caff428 100644 --- a/fcs/FSharp.Compiler.Service.Tests/FsxCompletionProviderTests.fs +++ b/fcs/FSharp.Compiler.Service.Tests/FsxCompletionProviderTests.fs @@ -23,7 +23,7 @@ namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn open System open System.Collections.Generic open System.IO -open System.Linq +open System.Linq open System.Reflection open NUnit.Framework diff --git a/fcs/FSharp.Compiler.Service.Tests/ProjectOptionsBuilder.fs b/fcs/FSharp.Compiler.Service.Tests/ProjectOptionsBuilder.fs index 1d3df25165..106b7602a5 100644 --- a/fcs/FSharp.Compiler.Service.Tests/ProjectOptionsBuilder.fs +++ b/fcs/FSharp.Compiler.Service.Tests/ProjectOptionsBuilder.fs @@ -5,6 +5,19 @@ open System.IO open System.Xml.Linq open FSharp.Compiler.SourceCodeServices +module FileSystemHelpers = + let safeDeleteFile (path: string) = + try + File.Delete(path) + with + | _ -> () + + let safeDeleteDirectory (path: string) = + try + Directory.Delete(path) + with + | _ -> () + type FSharpProject = { Directory: string @@ -29,9 +42,10 @@ type FSharpProject = member this.Dispose() = // delete each source file this.Files - |> List.iter (fun (path, _contents) -> File.Delete(path)) + |> List.map fst + |> List.iter FileSystemHelpers.safeDeleteFile // delete the directory - Directory.Delete(this.Directory) + FileSystemHelpers.safeDeleteDirectory (this.Directory) // project file doesn't really exist, nothing to delete () diff --git a/fcs/RELEASE_NOTES.md b/fcs/RELEASE_NOTES.md index d97e3851ae..7c84f0c6ea 100644 --- a/fcs/RELEASE_NOTES.md +++ b/fcs/RELEASE_NOTES.md @@ -1,8 +1,8 @@ -#### 34.0.0 +#### 34.0.1 -Contains commits from 32b124966 to 5a0117048 from dotnet/fsharp. Notable changes include: +Contains commits from 32b124966 to d7018737c from dotnet/fsharp. Notable changes include: -* lowered allocations for large strings and char arrays (notable source file texts) +* lowered allocations for large strings and char arrays (notably source file texts) * improved support for byreflike rules with regards to type abbreviations * better support for scopes in recursive modules * better location of .net core reference assemblies @@ -11,8 +11,9 @@ Contains commits from 32b124966 to 5a0117048 from dotnet/fsharp. Notable changes * FSharpChecker learned how to keep background symbol uses * Project cracker/project cracker tool were removed * Better support for consuming C# inref parameters -* preview-level functionality for #r "nuget" in scripts * new services around simplifing names and finding unused declarations +* package management in scripts (in preview) +* and-bang syntax support (in preview) #### 33.0.1 diff --git a/fcs/build.fsx b/fcs/build.fsx index fdfbb286e1..aba0c0fdc9 100644 --- a/fcs/build.fsx +++ b/fcs/build.fsx @@ -64,8 +64,8 @@ Target.create "BuildVersion" (fun _ -> Target.create "Build" (fun _ -> runDotnet __SOURCE_DIRECTORY__ "build" "../src/buildtools/buildtools.proj -v n -c Proto" - let fslexPath = __SOURCE_DIRECTORY__ + "/../artifacts/bin/fslex/Proto/netcoreapp2.1/fslex.dll" - let fsyaccPath = __SOURCE_DIRECTORY__ + "/../artifacts/bin/fsyacc/Proto/netcoreapp2.1/fsyacc.dll" + let fslexPath = Path.GetFullPath <| Path.Combine(__SOURCE_DIRECTORY__, "../artifacts/bin/fslex/Proto/netcoreapp3.1/fslex.dll") + let fsyaccPath = Path.GetFullPath <| Path.Combine(__SOURCE_DIRECTORY__, "../artifacts/bin/fsyacc/Proto/netcoreapp3.1/fsyacc.dll") runDotnet __SOURCE_DIRECTORY__ "build" (sprintf "FSharp.Compiler.Service.sln -nodereuse:false -v n -c Release /p:DisableCompilerRedirection=true /p:FsLexPath=%s /p:FsYaccPath=%s" fslexPath fsyaccPath) ) @@ -73,9 +73,9 @@ Target.create "Test" (fun _ -> // This project file is used for the netcoreapp2.0 tests to work out reference sets runDotnet __SOURCE_DIRECTORY__ "build" "../tests/projects/Sample_NETCoreSDK_FSharp_Library_netstandard2_0/Sample_NETCoreSDK_FSharp_Library_netstandard2_0.fsproj -nodereuse:false -v n /restore /p:DisableCompilerRedirection=true" - // Now run the tests - let logFilePath = Path.Combine(__SOURCE_DIRECTORY__, "..", "artifacts", "TestResults", "Release", "FSharp.Compiler.Service.Test.xml") - runDotnet __SOURCE_DIRECTORY__ "test" (sprintf "FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj --no-restore --no-build -nodereuse:false -v n -c Release --test-adapter-path . --logger \"nunit;LogFilePath=%s\"" logFilePath) + // Now run the tests (different output files per TFM) + let logFilePath = Path.Combine(__SOURCE_DIRECTORY__, "..", "artifacts", "TestResults", "Release", "FSharp.Compiler.Service.Test.{framework}.xml") + runDotnet __SOURCE_DIRECTORY__ "test" (sprintf "FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj --no-restore --no-build -nodereuse:false -v n -c Release --logger \"nunit;LogFilePath=%s\"" logFilePath) ) Target.create "NuGet" (fun _ -> diff --git a/fcs/global.json b/fcs/global.json index 2223a05e31..7c332016b7 100644 --- a/fcs/global.json +++ b/fcs/global.json @@ -1,5 +1,5 @@ { "sdk": { - "version": "3.0.100" + "version": "3.1.100" } } \ No newline at end of file diff --git a/fcs/samples/FscExe/FscMain.fs b/fcs/samples/FscExe/FscMain.fs index b2d5d6a899..36b980cbbb 100644 --- a/fcs/samples/FscExe/FscMain.fs +++ b/fcs/samples/FscExe/FscMain.fs @@ -8,7 +8,7 @@ open System.IO open System.Reflection open System.Runtime.CompilerServices open FSharp.Compiler.SourceCodeServices -open FSharp.Compiler.AbstractIL.IL // runningOnMono +open FSharp.Compiler.AbstractIL.Internal.Utils // runningOnMono open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.ErrorLogger diff --git a/global.json b/global.json index f12de76387..d41648cb6b 100644 --- a/global.json +++ b/global.json @@ -10,7 +10,7 @@ } }, "msbuild-sdks": { - "Microsoft.DotNet.Arcade.Sdk": "1.0.0-beta.19616.5", + "Microsoft.DotNet.Arcade.Sdk": "1.0.0-beta.20077.3", "Microsoft.DotNet.Helix.Sdk": "2.0.0-beta.19069.2" } } diff --git a/src/absil/bytes.fs b/src/absil/bytes.fs index 24159a728c..52d041c367 100755 --- a/src/absil/bytes.fs +++ b/src/absil/bytes.fs @@ -12,6 +12,25 @@ open FSharp.NativeInterop #nowarn "9" +module Utils = + let runningOnMono = + #if ENABLE_MONO_SUPPORT + // Officially supported way to detect if we are running on Mono. + // See http://www.mono-project.com/FAQ:_Technical + // "How can I detect if am running in Mono?" section + try + System.Type.GetType ("Mono.Runtime") <> null + with _ -> + // Must be robust in the case that someone else has installed a handler into System.AppDomain.OnTypeResolveEvent + // that is not reliable. + // This is related to bug 5506--the issue is actually a bug in VSTypeResolutionService.EnsurePopulated which is + // called by OnTypeResolveEvent. The function throws a NullReferenceException. I'm working with that team to get + // their issue fixed but we need to be robust here anyway. + false + #else + false + #endif + module internal Bytes = let b0 n = (n &&& 0xFF) let b1 n = ((n >>> 8) &&& 0xFF) @@ -66,6 +85,10 @@ type ByteMemory () = type ByteArrayMemory(bytes: byte[], offset, length) = inherit ByteMemory() + let checkCount count = + if count < 0 then + raise (ArgumentOutOfRangeException("count", "Count is less than zero.")) + do if length < 0 || length > bytes.Length then raise (ArgumentOutOfRangeException("length")) @@ -80,7 +103,11 @@ type ByteArrayMemory(bytes: byte[], offset, length) = override _.Length = length override _.ReadBytes(pos, count) = - Array.sub bytes (offset + pos) count + checkCount count + if count > 0 then + Array.sub bytes (offset + pos) count + else + Array.empty override _.ReadInt32 pos = let finalOffset = offset + pos @@ -96,25 +123,45 @@ type ByteArrayMemory(bytes: byte[], offset, length) = ((uint16 bytes.[finalOffset + 1]) <<< 8) override _.ReadUtf8String(pos, count) = - System.Text.Encoding.UTF8.GetString(bytes, offset + pos, count) + checkCount count + if count > 0 then + System.Text.Encoding.UTF8.GetString(bytes, offset + pos, count) + else + String.Empty override _.Slice(pos, count) = - ByteArrayMemory(bytes, offset + pos, count) :> ByteMemory + checkCount count + if count > 0 then + ByteArrayMemory(bytes, offset + pos, count) :> ByteMemory + else + ByteArrayMemory(Array.empty, 0, 0) :> ByteMemory override _.CopyTo stream = - stream.Write(bytes, offset, length) + if length > 0 then + stream.Write(bytes, offset, length) override _.Copy(srcOffset, dest, destOffset, count) = - Array.blit bytes (offset + srcOffset) dest destOffset count + checkCount count + if count > 0 then + Array.blit bytes (offset + srcOffset) dest destOffset count override _.ToArray() = - Array.sub bytes offset length + if length > 0 then + Array.sub bytes offset length + else + Array.empty override _.AsStream() = - new MemoryStream(bytes, offset, length) :> Stream + if length > 0 then + new MemoryStream(bytes, offset, length) :> Stream + else + new MemoryStream([||], 0, 0, false) :> Stream override _.AsReadOnlyStream() = - new MemoryStream(bytes, offset, length, false) :> Stream + if length > 0 then + new MemoryStream(bytes, offset, length, false) :> Stream + else + new MemoryStream([||], 0, 0, false) :> Stream [] type SafeUnmanagedMemoryStream = @@ -149,6 +196,10 @@ type RawByteMemory(addr: nativeptr, length: int, holder: obj) = if i < 0 || i >= length then raise (ArgumentOutOfRangeException("i")) + let checkCount count = + if count < 0 then + raise (ArgumentOutOfRangeException("count", "Count is less than zero.")) + do if length < 0 then raise (ArgumentOutOfRangeException("length")) @@ -165,16 +216,24 @@ type RawByteMemory(addr: nativeptr, length: int, holder: obj) = override _.Length = length override _.ReadUtf8String(pos, count) = - check pos - check (pos + count - 1) - System.Text.Encoding.UTF8.GetString(NativePtr.add addr pos, count) + checkCount count + if count > 0 then + check pos + check (pos + count - 1) + System.Text.Encoding.UTF8.GetString(NativePtr.add addr pos, count) + else + String.Empty - override _.ReadBytes(pos, count) = - check pos - check (pos + count - 1) - let res = Bytes.zeroCreate count - Marshal.Copy(NativePtr.toNativeInt addr + nativeint pos, res, 0, count) - res + override _.ReadBytes(pos, count) = + checkCount count + if count > 0 then + check pos + check (pos + count - 1) + let res = Bytes.zeroCreate count + Marshal.Copy(NativePtr.toNativeInt addr + nativeint pos, res, 0, count) + res + else + Array.empty override _.ReadInt32 pos = check pos @@ -187,28 +246,44 @@ type RawByteMemory(addr: nativeptr, length: int, holder: obj) = uint16(Marshal.ReadInt16(NativePtr.toNativeInt addr + nativeint pos)) override _.Slice(pos, count) = - check pos - check (pos + count - 1) - RawByteMemory(NativePtr.add addr pos, count, holder) :> ByteMemory + checkCount count + if count > 0 then + check pos + check (pos + count - 1) + RawByteMemory(NativePtr.add addr pos, count, holder) :> ByteMemory + else + ByteArrayMemory(Array.empty, 0, 0) :> ByteMemory override x.CopyTo stream = - use stream2 = x.AsStream() - stream2.CopyTo stream + if length > 0 then + use stream2 = x.AsStream() + stream2.CopyTo stream override _.Copy(srcOffset, dest, destOffset, count) = - check srcOffset - Marshal.Copy(NativePtr.toNativeInt addr + nativeint srcOffset, dest, destOffset, count) + checkCount count + if count > 0 then + check srcOffset + Marshal.Copy(NativePtr.toNativeInt addr + nativeint srcOffset, dest, destOffset, count) override _.ToArray() = - let res = Array.zeroCreate length - Marshal.Copy(NativePtr.toNativeInt addr, res, 0, res.Length) - res + if length > 0 then + let res = Array.zeroCreate length + Marshal.Copy(NativePtr.toNativeInt addr, res, 0, res.Length) + res + else + Array.empty override _.AsStream() = - new SafeUnmanagedMemoryStream(addr, int64 length, holder) :> Stream + if length > 0 then + new SafeUnmanagedMemoryStream(addr, int64 length, holder) :> Stream + else + new MemoryStream([||], 0, 0, false) :> Stream override _.AsReadOnlyStream() = - new SafeUnmanagedMemoryStream(addr, int64 length, int64 length, FileAccess.Read, holder) :> Stream + if length > 0 then + new SafeUnmanagedMemoryStream(addr, int64 length, int64 length, FileAccess.Read, holder) :> Stream + else + new MemoryStream([||], 0, 0, false) :> Stream [] type ReadOnlyByteMemory(bytes: ByteMemory) = @@ -240,65 +315,72 @@ type ByteMemory with member x.AsReadOnly() = ReadOnlyByteMemory x static member CreateMemoryMappedFile(bytes: ReadOnlyByteMemory) = - let length = int64 bytes.Length - let mmf = + if Utils.runningOnMono + then + // mono's MemoryMappedFile implementation throws with null `mapName`, so we use byte arrays instead: https://github.com/mono/mono/issues/10245 + ByteArrayMemory.FromArray (bytes.ToArray()) :> ByteMemory + else + let length = int64 bytes.Length let mmf = - MemoryMappedFile.CreateNew( - null, - length, - MemoryMappedFileAccess.ReadWrite, - MemoryMappedFileOptions.None, - HandleInheritability.None) - use stream = mmf.CreateViewStream(0L, length, MemoryMappedFileAccess.ReadWrite) - bytes.CopyTo stream - mmf - - let accessor = mmf.CreateViewAccessor(0L, length, MemoryMappedFileAccess.ReadWrite) - RawByteMemory.FromUnsafePointer(accessor.SafeMemoryMappedViewHandle.DangerousGetHandle(), int length, (mmf, accessor)) + let mmf = MemoryMappedFile.CreateNew(null, length, MemoryMappedFileAccess.ReadWrite, MemoryMappedFileOptions.None, HandleInheritability.None) + use stream = mmf.CreateViewStream(0L, length, MemoryMappedFileAccess.ReadWrite) + bytes.CopyTo stream + mmf + + let accessor = mmf.CreateViewAccessor(0L, length, MemoryMappedFileAccess.ReadWrite) + RawByteMemory.FromUnsafePointer(accessor.SafeMemoryMappedViewHandle.DangerousGetHandle(), int length, (mmf, accessor)) static member FromFile(path, access, ?canShadowCopy: bool) = let canShadowCopy = defaultArg canShadowCopy false - let memoryMappedFileAccess = - match access with - | FileAccess.Read -> MemoryMappedFileAccess.Read - | FileAccess.Write -> MemoryMappedFileAccess.Write - | _ -> MemoryMappedFileAccess.ReadWrite + if Utils.runningOnMono + then + // mono's MemoryMappedFile implementation throws with null `mapName`, so we use byte arrays instead: https://github.com/mono/mono/issues/10245 + let bytes = File.ReadAllBytes path + ByteArrayMemory.FromArray bytes + else + let memoryMappedFileAccess = + match access with + | FileAccess.Read -> MemoryMappedFileAccess.Read + | FileAccess.Write -> MemoryMappedFileAccess.Write + | _ -> MemoryMappedFileAccess.ReadWrite - let mmf, accessor, length = let fileStream = File.Open(path, FileMode.Open, access, FileShare.Read) + let length = fileStream.Length - let mmf = - if canShadowCopy then - let mmf = - MemoryMappedFile.CreateNew( - null, - length, - MemoryMappedFileAccess.ReadWrite, - MemoryMappedFileOptions.None, - HandleInheritability.None) - use stream = mmf.CreateViewStream(0L, length, MemoryMappedFileAccess.ReadWrite) - fileStream.CopyTo(stream) - fileStream.Dispose() - mmf - else - MemoryMappedFile.CreateFromFile( - fileStream, - null, - length, - memoryMappedFileAccess, - HandleInheritability.None, - leaveOpen=false) - mmf, mmf.CreateViewAccessor(0L, length, memoryMappedFileAccess), length - - // Validate MMF with the access that was intended. - match access with - | FileAccess.Read when not accessor.CanRead -> invalidOp "Cannot read file" - | FileAccess.Write when not accessor.CanWrite -> invalidOp "Cannot write file" - | FileAccess.ReadWrite when not accessor.CanRead || not accessor.CanWrite -> invalidOp "Cannot read or write file" - | _ -> () - - RawByteMemory.FromUnsafePointer(accessor.SafeMemoryMappedViewHandle.DangerousGetHandle(), int length, (mmf, accessor)) + + let mmf, accessor, length = + let mmf = + if canShadowCopy then + let mmf = + MemoryMappedFile.CreateNew( + null, + length, + MemoryMappedFileAccess.ReadWrite, + MemoryMappedFileOptions.None, + HandleInheritability.None) + use stream = mmf.CreateViewStream(0L, length, MemoryMappedFileAccess.ReadWrite) + fileStream.CopyTo(stream) + fileStream.Dispose() + mmf + else + MemoryMappedFile.CreateFromFile( + fileStream, + null, + length, + memoryMappedFileAccess, + HandleInheritability.None, + leaveOpen=false) + mmf, mmf.CreateViewAccessor(0L, length, memoryMappedFileAccess), length + + // Validate MMF with the access that was intended. + match access with + | FileAccess.Read when not accessor.CanRead -> invalidOp "Cannot read file" + | FileAccess.Write when not accessor.CanWrite -> invalidOp "Cannot write file" + | FileAccess.ReadWrite when not accessor.CanRead || not accessor.CanWrite -> invalidOp "Cannot read or write file" + | _ -> () + + RawByteMemory.FromUnsafePointer(accessor.SafeMemoryMappedViewHandle.DangerousGetHandle(), int length, (mmf, accessor)) static member FromUnsafePointer(addr, length, holder: obj) = RawByteMemory(NativePtr.ofNativeInt addr, length, holder) :> ByteMemory diff --git a/src/absil/bytes.fsi b/src/absil/bytes.fsi index 46b30b6c5a..55a48e3e46 100755 --- a/src/absil/bytes.fsi +++ b/src/absil/bytes.fsi @@ -5,10 +5,11 @@ namespace FSharp.Compiler.AbstractIL.Internal open System.IO open Internal.Utilities - open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.Internal +module Utils = + val runningOnMono: bool module internal Bytes = /// returned int will be 0 <= x <= 255 diff --git a/src/absil/il.fs b/src/absil/il.fs index ca9bfb808c..4c10a25952 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -25,24 +25,6 @@ open Internal.Utilities let logging = false -let runningOnMono = -#if ENABLE_MONO_SUPPORT -// Officially supported way to detect if we are running on Mono. -// See http://www.mono-project.com/FAQ:_Technical -// "How can I detect if am running in Mono?" section - try - System.Type.GetType ("Mono.Runtime") <> null - with e-> - // Must be robust in the case that someone else has installed a handler into System.AppDomain.OnTypeResolveEvent - // that is not reliable. - // This is related to bug 5506--the issue is actually a bug in VSTypeResolutionService.EnsurePopulated which is - // called by OnTypeResolveEvent. The function throws a NullReferenceException. I'm working with that team to get - // their issue fixed but we need to be robust here anyway. - false -#else - false -#endif - let _ = if logging then dprintn "* warning: Il.logging is on" let int_order = LanguagePrimitives.FastGenericComparer diff --git a/src/absil/il.fsi b/src/absil/il.fsi index 506878e1d6..7bbfad1eb2 100755 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -2012,8 +2012,6 @@ type ILPropertyRef = member Name: string interface System.IComparable -val runningOnMono: bool - type ILReferences = { AssemblyReferences: ILAssemblyRef list ModuleReferences: ILModuleRef list } diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index b9994f6418..f399c05684 100755 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -20,12 +20,13 @@ open System.Text open Internal.Utilities open Internal.Utilities.Collections open FSharp.NativeInterop -open FSharp.Compiler.AbstractIL.Internal -open FSharp.Compiler.AbstractIL.Internal.Support open FSharp.Compiler.AbstractIL.Diagnostics +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.BinaryConstants -open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Support +open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Range open System.Reflection diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index edab65fb7a..0aa03cb6e7 100755 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -17,6 +17,7 @@ open System.Collections.Generic open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.ErrorLogger diff --git a/src/absil/ilsupp.fs b/src/absil/ilsupp.fs index d818f75b96..1012cf6622 100755 --- a/src/absil/ilsupp.fs +++ b/src/absil/ilsupp.fs @@ -3,9 +3,9 @@ module internal FSharp.Compiler.AbstractIL.Internal.Support open FSharp.Compiler.AbstractIL -open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Internal.NativeRes +open FSharp.Compiler.AbstractIL.Internal.Utils #if FX_NO_CORHOST_SIGNER open FSharp.Compiler.AbstractIL.Internal.StrongNameSign #endif @@ -1268,7 +1268,7 @@ let getICLRStrongName () = | Some sn -> sn let signerGetPublicKeyForKeyPair kp = - if IL.runningOnMono then + if runningOnMono then let snt = System.Type.GetType("Mono.Security.StrongName") let sn = System.Activator.CreateInstance(snt, [| box kp |]) snt.InvokeMember("PublicKey", (BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public), null, sn, [| |], Globalization.CultureInfo.InvariantCulture) :?> byte[] @@ -1300,7 +1300,7 @@ let signerCloseKeyContainer kc = iclrSN.StrongNameKeyDelete kc |> ignore let signerSignatureSize (pk: byte[]) = - if IL.runningOnMono then + if runningOnMono then if pk.Length > 32 then pk.Length - 32 else 128 else let mutable pSize = 0u @@ -1309,7 +1309,7 @@ let signerSignatureSize (pk: byte[]) = int pSize let signerSignFileWithKeyPair fileName kp = - if IL.runningOnMono then + if runningOnMono then let snt = System.Type.GetType("Mono.Security.StrongName") let sn = System.Activator.CreateInstance(snt, [| box kp |]) let conv (x: obj) = if (unbox x: bool) then 0 else -1 diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index ed762cf9ac..e39a0fd11c 100755 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -6,12 +6,13 @@ open System.Collections.Generic open System.IO open Internal.Utilities -open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.AbstractIL.Diagnostics -open FSharp.Compiler.AbstractIL.Internal -open FSharp.Compiler.AbstractIL.Internal.BinaryConstants -open FSharp.Compiler.AbstractIL.Internal.Support -open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.Diagnostics +open FSharp.Compiler.AbstractIL.Internal +open FSharp.Compiler.AbstractIL.Internal.BinaryConstants +open FSharp.Compiler.AbstractIL.Internal.Support +open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Range diff --git a/src/absil/ilwritepdb.fs b/src/absil/ilwritepdb.fs index 682b20a688..564cd99083 100644 --- a/src/absil/ilwritepdb.fs +++ b/src/absil/ilwritepdb.fs @@ -15,6 +15,7 @@ open Internal.Utilities open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Internal.Support open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Range @@ -244,7 +245,7 @@ let pdbGetDebugInfo (contentId: byte[]) (timestamp: int32) (filepath: string) // This function takes output file name and returns debug file name. let getDebugFileName outfile (portablePDB: bool) = #if ENABLE_MONO_SUPPORT - if IL.runningOnMono && not portablePDB then + if runningOnMono && not portablePDB then outfile + ".mdb" else #else diff --git a/src/buildtools/fslex/fslex.fsproj b/src/buildtools/fslex/fslex.fsproj index 2766098c25..b705f606c8 100644 --- a/src/buildtools/fslex/fslex.fsproj +++ b/src/buildtools/fslex/fslex.fsproj @@ -2,7 +2,7 @@ Exe - netcoreapp2.1 + netcoreapp3.1 INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstant) true diff --git a/src/buildtools/fsyacc/fsyacc.fsproj b/src/buildtools/fsyacc/fsyacc.fsproj index dc5a4f67f3..fb744a43cd 100644 --- a/src/buildtools/fsyacc/fsyacc.fsproj +++ b/src/buildtools/fsyacc/fsyacc.fsproj @@ -2,7 +2,7 @@ Exe - netcoreapp2.1 + netcoreapp3.1 INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstant) true diff --git a/src/fsharp/AttributeChecking.fs b/src/fsharp/AttributeChecking.fs index fb19937c53..056858d93f 100644 --- a/src/fsharp/AttributeChecking.fs +++ b/src/fsharp/AttributeChecking.fs @@ -265,9 +265,10 @@ let private CheckILAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m = | _ -> CompleteD +let langVersionPrefix = "--langversion:preview" + /// Check F# attributes for 'ObsoleteAttribute', 'CompilerMessageAttribute' and 'ExperimentalAttribute', /// returning errors and warnings as data -let langVersionPrefix = "--langversion:preview" let CheckFSharpAttributes (g:TcGlobals) attribs m = let isExperimentalAttributeDisabled (s:string) = if g.compilingFslib then diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 41d863dab0..b6b18dc7c6 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -20,6 +20,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.AbstractIL.Extensions.ILX open FSharp.Compiler.AbstractIL.Diagnostics @@ -1004,6 +1005,8 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa | Parser.TOKEN_OLET(_) -> getErrorString("Parser.TOKEN.OLET") | Parser.TOKEN_OBINDER | Parser.TOKEN_BINDER -> getErrorString("Parser.TOKEN.BINDER") + | Parser.TOKEN_OAND_BANG + | Parser.TOKEN_AND_BANG -> getErrorString("Parser.TOKEN.AND.BANG") | Parser.TOKEN_ODO -> getErrorString("Parser.TOKEN.ODO") | Parser.TOKEN_OWITH -> getErrorString("Parser.TOKEN.OWITH") | Parser.TOKEN_OFUNCTION -> getErrorString("Parser.TOKEN.OFUNCTION") @@ -2168,8 +2171,6 @@ type TcConfigBuilder = mutable pathMap: PathMap mutable langVersion: LanguageVersion - - mutable includePathAdded: string -> unit } static member Initial = @@ -2310,18 +2311,16 @@ type TcConfigBuilder = noConditionalErasure = false pathMap = PathMap.empty langVersion = LanguageVersion("default") - includePathAdded = ignore } static member CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir, reduceMemoryUsage, implicitIncludeDir, - isInteractive, isInvalidationSupported, defaultCopyFSharpCore, tryGetMetadataSnapshot, ?includePathAdded: string -> unit) = + isInteractive, isInvalidationSupported, defaultCopyFSharpCore, tryGetMetadataSnapshot) = Debug.Assert(FileSystem.IsPathRootedShim implicitIncludeDir, sprintf "implicitIncludeDir should be absolute: '%s'" implicitIncludeDir) if (String.IsNullOrEmpty defaultFSharpBinariesDir) then failwith "Expected a valid defaultFSharpBinariesDir" - let includePathAdded = defaultArg includePathAdded ignore { TcConfigBuilder.Initial with implicitIncludeDir = implicitIncludeDir defaultFSharpBinariesDir = defaultFSharpBinariesDir @@ -2331,7 +2330,6 @@ type TcConfigBuilder = isInvalidationSupported = isInvalidationSupported copyFSharpCore = defaultCopyFSharpCore tryGetMetadataSnapshot = tryGetMetadataSnapshot - includePathAdded = includePathAdded useFsiAuxLib = isInteractive } @@ -2408,7 +2406,6 @@ type TcConfigBuilder = | None -> false if ok && not (List.contains absolutePath tcConfigB.includes) then tcConfigB.includes <- tcConfigB.includes ++ absolutePath - tcConfigB.includePathAdded absolutePath member tcConfigB.AddLoadedSource(m, originalPath, pathLoadedFrom) = if FileSystem.IsInvalidPathShim originalPath then @@ -4833,10 +4830,10 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse /// Process #r in F# Interactive. /// Adds the reference to the tcImports and add the ccu to the type checking environment. -let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, m, file, assemblyReferenceAdded: string -> unit) = +let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, m, file) = let resolutions = CommitOperationResult(tcImports.TryResolveAssemblyReference(ctok, AssemblyReference(m, file, None), ResolveAssemblyReferenceMode.ReportErrors)) let dllinfos, ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) |> Cancellable.runWithoutCancellation - + let asms = ccuinfos |> List.map (function | ResolvedImportedAssembly asm -> asm @@ -4845,11 +4842,7 @@ let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, m, file, as let g = tcImports.GetTcGlobals() let amap = tcImports.GetImportMap() let buildTcEnv tcEnv asm = - let tcEnv = AddCcuToTcEnv(g, amap, m, tcEnv, thisAssemblyName, asm.FSharpViewOfMetadata, asm.AssemblyAutoOpenAttributes, asm.AssemblyInternalsVisibleToAttributes) - match asm.FSharpViewOfMetadata.FileName with - | Some asmPath -> assemblyReferenceAdded asmPath - | None -> () - tcEnv + AddCcuToTcEnv(g, amap, m, tcEnv, thisAssemblyName, asm.FSharpViewOfMetadata, asm.AssemblyAutoOpenAttributes, asm.AssemblyInternalsVisibleToAttributes) let tcEnv = (tcEnv, asms) ||> List.fold buildTcEnv tcEnv, (dllinfos, asms) @@ -5146,7 +5139,6 @@ module ScriptPreprocessClosure = let getWarningNumber = fun () (m, s) -> nowarns <- (s, m) :: nowarns let addReferencedAssemblyByPath = fun () (m, s) -> tcConfigB.AddReferencedAssemblyByPath(m, s) let addDependencyManagerText = fun () (packageManagerPrefix,m,s) -> tcConfigB.AddDependencyManagerText(packageManagerPrefix,m,s) - let addLoadedSource = fun () (m, s) -> tcConfigB.AddLoadedSource(m, s, pathOfMetaCommandSource) try ProcessMetaCommandsFromInput (getWarningNumber, addReferencedAssemblyByPath, addDependencyManagerText, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) @@ -5161,7 +5153,7 @@ module ScriptPreprocessClosure = let tcConfigB = tcConfig.CloneOfOriginalBuilder TcConfig.Create(tcConfigB, validate=false), nowarns - let FindClosureFiles(mainFile, _m, closureSources, origTcConfig:TcConfig, codeContext, lexResourceManager: Lexhelp.LexResourceManager) = + let FindClosureFiles(_mainFile, _m, closureSources, origTcConfig:TcConfig, codeContext, lexResourceManager: Lexhelp.LexResourceManager) = let mutable tcConfig = origTcConfig let observedSources = Observed() @@ -5185,7 +5177,7 @@ module ScriptPreprocessClosure = let inline snd3 (_, b, _) = b let packageManagerTextLines = packageManagerLines |> List.map snd3 - match DependencyManagerIntegration.resolve packageManager tcConfig.implicitIncludeDir mainFile scriptName m packageManagerTextLines with + match DependencyManagerIntegration.resolve packageManager ".fsx" m packageManagerTextLines with | None -> () // error already reported | Some (succeeded, generatedScripts, additionalIncludeFolders) -> //@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ // This may incrementally update tcConfig too with new #r references @@ -5232,23 +5224,19 @@ module ScriptPreprocessClosure = let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn (tcConfig, parsedScriptAst, pathOfMetaCommandSource) tcConfig <- tcConfigResult // We accumulate the tcConfig in order to collect assembly references - + + yield! resolveDependencyManagerSources filename + let postSources = tcConfig.GetAvailableLoadedSources() let sources = if preSources.Length < postSources.Length then postSources.[preSources.Length..] else [] yield! resolveDependencyManagerSources filename -#if DEBUG - for (_,subFile) in sources do - printfn "visiting %s - has subsource of %s " filename subFile -#endif for (m, subFile) in sources do if IsScript subFile then for subSource in ClosureSourceOfFilename(subFile, m, tcConfigResult.inputCodePage, false) do yield! loop subSource else yield ClosureFile(subFile, m, None, [], [], []) - - //printfn "yielding source %s" filename yield ClosureFile(filename, m, Some parsedScriptAst, parseDiagnostics, errorLogger.Diagnostics, noWarns) | None -> diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index fd95afdd20..0c92d463d3 100644 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -389,8 +389,6 @@ type TcConfigBuilder = mutable pathMap : PathMap mutable langVersion : LanguageVersion - - mutable includePathAdded : string -> unit } static member Initial: TcConfigBuilder @@ -403,8 +401,7 @@ type TcConfigBuilder = isInteractive: bool * isInvalidationSupported: bool * defaultCopyFSharpCore: CopyFSharpCoreFlag * - tryGetMetadataSnapshot: ILReaderTryGetMetadataSnapshot * - ?includePathAdded: (string -> unit) + tryGetMetadataSnapshot: ILReaderTryGetMetadataSnapshot -> TcConfigBuilder member DecideNames: string list -> outfile: string * pdbfile: string option * assemblyName: string @@ -417,7 +414,7 @@ type TcConfigBuilder = member AddEmbeddedSourceFile: string -> unit member AddEmbeddedResource: string -> unit member AddPathMapping: oldPrefix: string * newPrefix: string -> unit - + static member SplitCommandLineResourceInfo: string -> string * string * ILResourceAccess [] @@ -684,7 +681,7 @@ val WriteOptimizationData: TcGlobals * filename: string * inMem: bool * CcuThunk /// Process #r in F# Interactive. /// Adds the reference to the tcImports and add the ccu to the type checking environment. -val RequireDLL: CompilationThreadToken * TcImports * TcEnv * thisAssemblyName: string * referenceRange: range * file: string * assemblyReferenceAdded: (string -> unit) -> TcEnv * (ImportedBinary list * ImportedAssembly list) +val RequireDLL: CompilationThreadToken * TcImports * TcEnv * thisAssemblyName: string * referenceRange: range * file: string -> TcEnv * (ImportedBinary list * ImportedAssembly list) /// Processing # commands val ProcessMetaCommandsFromInput : diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 6510790668..911f913f2f 100755 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -8,10 +8,11 @@ open Internal.Utilities open System open System.IO open FSharp.Compiler -open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.AbstractIL.Extensions.ILX open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompileOps diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 59b10f7be7..cce06e7024 100755 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -291,6 +291,22 @@ let rec occursCheck g un ty = // Predicates on types //------------------------------------------------------------------------- +/// Some additional solutions are forced prior to generalization (permitWeakResolution=true). These are, roughly speaking, rules +/// for binary-operand constraints arising from constructs such as "1.0 + x" where "x" is an unknown type. THe constraint here +/// involves two type parameters - one for the left, and one for the right. The left is already known to be Double. +/// In this situation (and in the absence of other evidence prior to generalization), constraint solving forces an assumption that +/// the right is also Double - this is "weak" because there is only weak evidence for it. +/// +/// permitWeakResolution also applies to resolutions of multi-type-variable constraints via method overloads. Method overloading gets applied even if +/// only one of the two type variables is known. +/// +/// During code gen we run with permitWeakResolution on, but we only apply it where one of the argument types for the built-in constraint resolution is +/// a variable type. +type PermitWeakResolution = + | Yes + | No + member x.Permit = match x with Yes -> true | No -> false + let rec isNativeIntegerTy g ty = typeEquivAux EraseMeasures g g.nativeint_ty ty || typeEquivAux EraseMeasures g g.unativeint_ty ty || @@ -310,10 +326,10 @@ let isUnsignedIntegerTy g ty = typeEquivAux EraseMeasures g g.unativeint_ty ty || typeEquivAux EraseMeasures g g.uint64_ty ty -let rec isIntegerOrIntegerEnumTy g ty = +let rec IsIntegerOrIntegerEnumTy g ty = isSignedIntegerTy g ty || isUnsignedIntegerTy g ty || - (isEnumTy g ty && isIntegerOrIntegerEnumTy g (underlyingTypeOfEnumTy g ty)) + (isEnumTy g ty && IsIntegerOrIntegerEnumTy g (underlyingTypeOfEnumTy g ty)) let isIntegerTy g ty = isSignedIntegerTy g ty || @@ -334,7 +350,7 @@ let isFpTy g ty = let isDecimalTy g ty = typeEquivAux EraseMeasures g g.decimal_ty ty -let IsNonDecimalNumericOrIntegralEnumType g ty = isIntegerOrIntegerEnumTy g ty || isFpTy g ty +let IsNonDecimalNumericOrIntegralEnumType g ty = IsIntegerOrIntegerEnumTy g ty || isFpTy g ty let IsNumericOrIntegralEnumType g ty = IsNonDecimalNumericOrIntegralEnumType g ty || isDecimalTy g ty @@ -353,6 +369,28 @@ let GetMeasureOfType g ty = | _ -> None | _ -> None +let IsCharOrStringType g ty = isCharTy g ty || isStringTy g ty + +/// Checks the argument type for a built-in solution to an op_Addition, op_Subtraction or op_Modulus constraint. +let IsAddSubModType nm g ty = IsNumericOrIntegralEnumType g ty || (nm = "op_Addition" && IsCharOrStringType g ty) + +/// Checks the argument type for a built-in solution to a bitwise operator constraint +let IsBitwiseOpType g ty = IsIntegerOrIntegerEnumTy g ty || (isEnumTy g ty) + +/// Check the other type in a built-in solution for a binary operator. +/// For weak resolution, require a relevant primitive on one side. +/// For strong resolution, a variable type is permitted. +let IsBinaryOpOtherArgType g permitWeakResolution ty = + match permitWeakResolution with + | PermitWeakResolution.No -> + not (isTyparTy g ty) + + | PermitWeakResolution.Yes -> true + +/// Checks the argument type for a built-in solution to a get_Sign constraint. +let IsSignType g ty = + isSignedIntegerTy g ty || isFpTy g ty || isDecimalTy g ty + type TraitConstraintSolution = | TTraitUnsolved | TTraitBuiltIn @@ -819,10 +857,12 @@ let rec SolveTyparEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optio // Only solve constraints if this is not an error var if r.IsFromError then () else + // Check to see if this type variable is relevant to any trait constraints. // If so, re-solve the relevant constraints. if csenv.SolverState.ExtraCxs.ContainsKey r.Stamp then - do! RepeatWhileD ndeep (fun ndeep -> SolveRelevantMemberConstraintsForTypar csenv ndeep false trace r) + do! RepeatWhileD ndeep (fun ndeep -> SolveRelevantMemberConstraintsForTypar csenv ndeep PermitWeakResolution.No trace r) + // Re-solve the other constraints associated with this type variable return! solveTypMeetsTyparConstraints csenv ndeep m2 trace ty r @@ -867,7 +907,7 @@ and solveTypMeetsTyparConstraints (csenv: ConstraintSolverEnv) ndeep m2 trace ty | TyparConstraint.SimpleChoice(tys, m2) -> SolveTypeChoice csenv ndeep m2 trace ty tys | TyparConstraint.CoercesTo(ty2, m2) -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m2 trace None ty2 ty | TyparConstraint.MayResolveMember(traitInfo, m2) -> - SolveMemberConstraint csenv false false ndeep m2 trace traitInfo |> OperationResult.ignore + SolveMemberConstraint csenv false PermitWeakResolution.No ndeep m2 trace traitInfo |> OperationResult.ignore } @@ -1136,16 +1176,9 @@ and SolveDimensionlessNumericType (csenv: ConstraintSolverEnv) ndeep m2 trace ty /// don't. The type-directed static optimization rules in the library code that makes use of this /// will deal with the problem. /// -/// 2. Some additional solutions are forced prior to generalization (permitWeakResolution=true). These are, roughly speaking, rules -/// for binary-operand constraints arising from constructs such as "1.0 + x" where "x" is an unknown type. THe constraint here -/// involves two type parameters - one for the left, and one for the right. The left is already known to be Double. -/// In this situation (and in the absence of other evidence prior to generalization), constraint solving forces an assumption that -/// the right is also Double - this is "weak" because there is only weak evidence for it. -/// -/// permitWeakResolution also applies to resolutions of multi-type-variable constraints via method overloads. Method overloading gets applied even if -/// only one of the two type variables is known -/// -and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload permitWeakResolution ndeep m2 trace (TTrait(tys, nm, memFlags, argtys, rty, sln)): OperationResult = trackErrors { +/// 2. Some additional solutions are forced prior to generalization (permitWeakResolution= Yes or YesDuringCodeGen). See above +and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload permitWeakResolution ndeep m2 trace traitInfo : OperationResult = trackErrors { + let (TTrait(tys, nm, memFlags, traitObjAndArgTys, rty, sln)) = traitInfo // Do not re-solve if already solved if sln.Value.IsSome then return true else let g = csenv.g @@ -1158,20 +1191,21 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload // Remove duplicates from the set of types in the support let tys = ListSet.setify (typeAEquiv g aenv) tys + // Rebuild the trait info after removing duplicates - let traitInfo = TTrait(tys, nm, memFlags, argtys, rty, sln) + let traitInfo = TTrait(tys, nm, memFlags, traitObjAndArgTys, rty, sln) let rty = GetFSharpViewOfReturnType g rty // Assert the object type if the constraint is for an instance member if memFlags.IsInstance then - match tys, argtys with + match tys, traitObjAndArgTys with | [ty], (h :: _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace h ty | _ -> do! ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m, m2)) // Trait calls are only supported on pseudo type (variables) for e in tys do do! SolveTypStaticReq csenv trace HeadTypeStaticReq e - let argtys = if memFlags.IsInstance then List.tail argtys else argtys + let argtys = if memFlags.IsInstance then List.tail traitObjAndArgTys else traitObjAndArgTys let minfos = GetRelevantMethodsForTrait csenv permitWeakResolution nm traitInfo @@ -1205,11 +1239,9 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload // decimal<'u> * 'a (let checkRuleAppliesInPreferenceToMethods argty1 argty2 = // Check that at least one of the argument types is numeric - (IsNumericOrIntegralEnumType g argty1) && - // Check that the support of type variables is empty. That is, - // if we're canonicalizing, then having one of the types nominal is sufficient. - // If not, then both must be nominal (i.e. not a type variable). - (permitWeakResolution || not (isTyparTy g argty2)) && + IsNumericOrIntegralEnumType g argty1 && + // Check the other type is nominal, unless using weak resolution + IsBinaryOpOtherArgType g permitWeakResolution argty2 && // This next condition checks that either // - Neither type contributes any methods OR // - We have the special case "decimal<_> * decimal". In this case we have some @@ -1244,8 +1276,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _, _, false, ("op_Addition" | "op_Subtraction" | "op_Modulus"), [argty1;argty2] when // Ignore any explicit +/- overloads from any basic integral types (minfos |> List.forall (fun minfo -> isIntegerTy g minfo.ApparentEnclosingType ) && - ( (IsNumericOrIntegralEnumType g argty1 || (nm = "op_Addition" && (isCharTy g argty1 || isStringTy g argty1))) && (permitWeakResolution || not (isTyparTy g argty2)) - || (IsNumericOrIntegralEnumType g argty2 || (nm = "op_Addition" && (isCharTy g argty2 || isStringTy g argty2))) && (permitWeakResolution || not (isTyparTy g argty1)))) -> + ( IsAddSubModType nm g argty1 && IsBinaryOpOtherArgType g permitWeakResolution argty2 + || IsAddSubModType nm g argty2 && IsBinaryOpOtherArgType g permitWeakResolution argty1)) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 argty1 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty1 return TTraitBuiltIn @@ -1253,8 +1285,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _, _, false, ("op_LessThan" | "op_LessThanOrEqual" | "op_GreaterThan" | "op_GreaterThanOrEqual" | "op_Equality" | "op_Inequality" ), [argty1;argty2] when // Ignore any explicit overloads from any basic integral types (minfos |> List.forall (fun minfo -> isIntegerTy g minfo.ApparentEnclosingType ) && - ( (IsRelationalType g argty1 && (permitWeakResolution || not (isTyparTy g argty2))) - || (IsRelationalType g argty2 && (permitWeakResolution || not (isTyparTy g argty1))))) -> + ( IsRelationalType g argty1 && IsBinaryOpOtherArgType g permitWeakResolution argty2 + || IsRelationalType g argty2 && IsBinaryOpOtherArgType g permitWeakResolution argty1)) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 argty1 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty g.bool_ty return TTraitBuiltIn @@ -1272,21 +1304,21 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty ty return TTraitBuiltIn - | [], _, false, ("DivideByInt"), [argty1;argty2] + | [], _, false, "DivideByInt", [argty1;argty2] when isFpTy g argty1 || isDecimalTy g argty1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 g.int_ty do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty1 return TTraitBuiltIn // We pretend for uniformity that the 'string' and 'array' types have an indexer property called 'Item' - | [], [ty], true, ("get_Item"), [argty1] + | [], [ty], true, "get_Item", [argty1] when isStringTy g ty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty1 g.int_ty do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty g.char_ty return TTraitBuiltIn - | [], [ty], true, ("get_Item"), argtys + | [], [ty], true, "get_Item", argtys when isArrayTy g ty -> if rankOfArrayTy g ty <> argtys.Length then do! ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), argtys.Length), m, m2)) @@ -1296,7 +1328,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty ety return TTraitBuiltIn - | [], [ty], true, ("set_Item"), argtys + | [], [ty], true, "set_Item", argtys when isArrayTy g ty -> if rankOfArrayTy g ty <> argtys.Length - 1 then do! ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), (argtys.Length - 1)), m, m2)) @@ -1308,8 +1340,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitBuiltIn | [], _, false, ("op_BitwiseAnd" | "op_BitwiseOr" | "op_ExclusiveOr"), [argty1;argty2] - when (isIntegerOrIntegerEnumTy g argty1 || (isEnumTy g argty1)) && (permitWeakResolution || not (isTyparTy g argty2)) - || (isIntegerOrIntegerEnumTy g argty2 || (isEnumTy g argty2)) && (permitWeakResolution || not (isTyparTy g argty1)) -> + when IsBitwiseOpType g argty1 && IsBinaryOpOtherArgType g permitWeakResolution argty2 + || IsBitwiseOpType g argty2 && IsBinaryOpOtherArgType g permitWeakResolution argty1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 argty1 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty1 @@ -1317,39 +1349,39 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitBuiltIn | [], _, false, ("op_LeftShift" | "op_RightShift"), [argty1;argty2] - when isIntegerOrIntegerEnumTy g argty1 -> + when IsIntegerOrIntegerEnumTy g argty1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 g.int_ty do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty1 do! SolveDimensionlessNumericType csenv ndeep m2 trace argty1 return TTraitBuiltIn - | _, _, false, ("op_UnaryPlus"), [argty] + | _, _, false, "op_UnaryPlus", [argty] when IsNumericOrIntegralEnumType g argty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty return TTraitBuiltIn - | _, _, false, ("op_UnaryNegation"), [argty] + | _, _, false, "op_UnaryNegation", [argty] when isSignedIntegerTy g argty || isFpTy g argty || isDecimalTy g argty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty return TTraitBuiltIn - | _, _, true, ("get_Sign"), [] - when (let argty = tys.Head in isSignedIntegerTy g argty || isFpTy g argty || isDecimalTy g argty) -> + | _, _, true, "get_Sign", [] + when IsSignType g tys.Head -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty g.int32_ty return TTraitBuiltIn | _, _, false, ("op_LogicalNot" | "op_OnesComplement"), [argty] - when isIntegerOrIntegerEnumTy g argty -> + when IsIntegerOrIntegerEnumTy g argty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty do! SolveDimensionlessNumericType csenv ndeep m2 trace argty return TTraitBuiltIn - | _, _, false, ("Abs"), [argty] + | _, _, false, "Abs", [argty] when isSignedIntegerTy g argty || isFpTy g argty || isDecimalTy g argty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty @@ -1374,7 +1406,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty return TTraitBuiltIn - | _, _, false, ("op_Explicit"), [argty] + | _, _, false, "op_Explicit", [argty] when (// The input type. (IsNonDecimalNumericOrIntegralEnumType g argty || isStringTy g argty || isCharTy g argty) && // The output type @@ -1387,7 +1419,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitBuiltIn - | _, _, false, ("op_Explicit"), [argty] + | _, _, false, "op_Explicit", [argty] when (// The input type. (IsNumericOrIntegralEnumType g argty || isStringTy g argty) && // The output type @@ -1403,7 +1435,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty1 return TTraitBuiltIn - | _, _, false, ("Atan2"), [argty1; argty2] + | _, _, false, "Atan2", [argty1; argty2] when isFpTy g argty1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 argty1 match GetMeasureOfType g argty1 with @@ -1534,7 +1566,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload // If there's nothing left to learn then raise the errors. // Note: we should likely call MemberConstraintIsReadyForResolution here when permitWeakResolution=false but for stability // reasons we use the more restrictive isNil frees. - if (permitWeakResolution && MemberConstraintIsReadyForWeakResolution csenv traitInfo) || isNil frees then + if (permitWeakResolution.Permit && MemberConstraintIsReadyForWeakResolution csenv traitInfo) || isNil frees then do! errors // Otherwise re-record the trait waiting for canonicalization else @@ -1587,10 +1619,13 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = let mref = IL.mkRefToILMethod (ilMeth.DeclaringTyconRef.CompiledRepresentationForNamedType, ilMeth.RawMetadata) let iltref = ilMeth.ILExtensionMethodDeclaringTyconRef |> Option.map (fun tcref -> tcref.CompiledRepresentationForNamedType) ILMethSln(ilMeth.ApparentEnclosingType, iltref, mref, minst) + | FSMeth(_, ty, vref, _) -> FSMethSln(ty, vref, minst) + | MethInfo.DefaultStructCtor _ -> error(InternalError("the default struct constructor was the unexpected solution to a trait constraint", m)) + #if !NO_EXTENSIONTYPING | ProvidedMeth(amap, mi, _, m) -> let g = amap.g @@ -1599,6 +1634,7 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = let objArgVars, objArgs = (if minfo.IsInstance then [mkLocal m "this" minfo.ApparentEnclosingType] else []) |> List.unzip let callMethInfoOpt, callExpr, callExprTy = ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall css.TcVal (g, amap, mi, objArgs, NeverMutates, false, ValUseFlag.NormalValUse, allArgs, m) let closedExprSln = ClosedExprSln (mkLambdas m [] (objArgVars@allArgVars) (callExpr, callExprTy) ) + // If the call is a simple call to an IL method with all the arguments in the natural order, then revert to use ILMethSln. // This is important for calls to operators on generated provided types. There is an (unchecked) condition // that generative providers do not re=order arguments or insert any more information into operator calls. @@ -1623,9 +1659,9 @@ and TransactMemberConstraintSolution traitInfo (trace: OptionalTrace) sln = /// Only consider overload resolution if canonicalizing or all the types are now nominal. /// That is, don't perform resolution if more nominal information may influence the set of available overloads -and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) permitWeakResolution nm (TTrait(tys, _, memFlags, argtys, rty, soln) as traitInfo): MethInfo list = +and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) (permitWeakResolution: PermitWeakResolution) nm (TTrait(tys, _, memFlags, argtys, rty, soln) as traitInfo): MethInfo list = let results = - if permitWeakResolution || MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then + if permitWeakResolution.Permit || MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then let m = csenv.m let minfos = match memFlags.MemberKind with @@ -1647,6 +1683,7 @@ and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) permitWeakResolution |> List.exists (fun minfo2 -> MethInfosEquivByNameAndSig EraseAll true csenv.g csenv.amap m minfo2 minfo1))) else [] + // The trait name "op_Explicit" also covers "op_Implicit", so look for that one too. if nm = "op_Explicit" then results @ GetRelevantMethodsForTrait csenv permitWeakResolution "op_Implicit" (TTrait(tys, "op_Implicit", memFlags, argtys, rty, soln)) @@ -1711,9 +1748,9 @@ and SolveRelevantMemberConstraintsForTypar (csenv: ConstraintSolverEnv) ndeep pe SolveMemberConstraint csenv true permitWeakResolution (ndeep+1) m2 trace traitInfo) and CanonicalizeRelevantMemberConstraints (csenv: ConstraintSolverEnv) ndeep trace tps = - SolveRelevantMemberConstraints csenv ndeep true trace tps + SolveRelevantMemberConstraints csenv ndeep PermitWeakResolution.Yes trace tps -and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace traitInfo support frees = +and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) traitInfo support (frees: Typar list) = let g = csenv.g let aenv = csenv.EquivEnv let cxst = csenv.SolverState.ExtraCxs @@ -1936,7 +1973,7 @@ and SolveTypeSupportsComparison (csenv: ConstraintSolverEnv) ndeep m2 trace ty = AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SupportsComparison m) | ValueNone -> // Check it isn't ruled out by the user - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref when HasFSharpAttribute g g.attrib_NoComparisonAttribute tcref.Attribs -> ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison1(NicePrint.minimalStringOfType denv ty), m, m2)) | _ -> @@ -1979,7 +2016,7 @@ and SolveTypeSupportsEquality (csenv: ConstraintSolverEnv) ndeep m2 trace ty = | ValueSome destTypar -> AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SupportsEquality m) | _ -> - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref when HasFSharpAttribute g g.attrib_NoEqualityAttribute tcref.Attribs -> ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality1(NicePrint.minimalStringOfType denv ty), m, m2)) | _ -> @@ -2113,13 +2150,13 @@ and SolveTypeRequiresDefaultConstructor (csenv: ConstraintSolverEnv) ndeep m2 tr if GetIntrinsicConstructorInfosOfType csenv.InfoReader m ty |> List.exists (fun x -> x.IsNullary && IsMethInfoAccessible amap m AccessibleFromEverywhere x) then - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref when HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs -> ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresNonAbstract(NicePrint.minimalStringOfType denv origTy), m, m2)) | _ -> CompleteD else - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref when tcref.PreEstablishedHasDefaultConstructor || // F# 3.1 feature: records with CLIMutable attribute should satisfy 'default constructor' constraint @@ -2545,7 +2582,7 @@ and ResolveOverloading (calledArg1.CalledArgumentType, calledArg2.CalledArgumentType) ||> compareCond (fun ty1 ty2 -> // Func<_> is always considered better than any other delegate type - match tryDestAppTy csenv.g ty1 with + match tryTcrefOfAppTy csenv.g ty1 with | ValueSome tcref1 when tcref1.DisplayName = "Func" && (match tcref1.PublicPath with Some p -> p.EnclosingPath = [| "System" |] | _ -> false) && @@ -2856,7 +2893,7 @@ let AddCxMethodConstraint denv css m trace traitInfo = (fun () -> trackErrors { do! - SolveMemberConstraint csenv true false 0 m trace traitInfo + SolveMemberConstraint csenv true PermitWeakResolution.No 0 m trace traitInfo |> OperationResult.ignore }) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) @@ -2963,33 +3000,42 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra InfoReader = new InfoReader(g, amap) } let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let! _res = SolveMemberConstraint csenv true true 0 m NoTrace traitInfo + + let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo + let sln = - match traitInfo.Solution with - | None -> Choice5Of5() - | Some sln -> - match sln with - | ILMethSln(origTy, extOpt, mref, minst) -> - let metadataTy = convertToTypeWithMetadataIfPossible g origTy - let tcref = tcrefOfAppTy g metadataTy - let mdef = IL.resolveILMethodRef tcref.ILTyconRawMetadata mref - let ilMethInfo = - match extOpt with - | None -> MethInfo.CreateILMeth(amap, m, origTy, mdef) - | Some ilActualTypeRef -> - let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef - MethInfo.CreateILExtensionMeth(amap, m, origTy, actualTyconRef, None, mdef) - Choice1Of5 (ilMethInfo, minst) - | FSMethSln(ty, vref, minst) -> - Choice1Of5 (FSMeth(g, ty, vref, None), minst) - | FSRecdFieldSln(tinst, rfref, isSetProp) -> - Choice2Of5 (tinst, rfref, isSetProp) - | FSAnonRecdFieldSln(anonInfo, tinst, i) -> - Choice3Of5 (anonInfo, tinst, i) - | BuiltInSln -> - Choice5Of5 () - | ClosedExprSln expr -> - Choice4Of5 expr + match traitInfo.Solution with + | None -> Choice5Of5() + | Some sln -> + + // Given the solution information, reconstruct the MethInfo for the solution + match sln with + | ILMethSln(origTy, extOpt, mref, minst) -> + let metadataTy = convertToTypeWithMetadataIfPossible g origTy + let tcref = tcrefOfAppTy g metadataTy + let mdef = IL.resolveILMethodRef tcref.ILTyconRawMetadata mref + let ilMethInfo = + match extOpt with + | None -> MethInfo.CreateILMeth(amap, m, origTy, mdef) + | Some ilActualTypeRef -> + let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef + MethInfo.CreateILExtensionMeth(amap, m, origTy, actualTyconRef, None, mdef) + Choice1Of5 (ilMethInfo, minst) + + | FSMethSln(ty, vref, minst) -> + Choice1Of5 (FSMeth(g, ty, vref, None), minst) + + | FSRecdFieldSln(tinst, rfref, isSetProp) -> + Choice2Of5 (tinst, rfref, isSetProp) + + | FSAnonRecdFieldSln(anonInfo, tinst, i) -> + Choice3Of5 (anonInfo, tinst, i) + + | BuiltInSln -> + Choice5Of5 () + + | ClosedExprSln expr -> + Choice4Of5 expr return! match sln with | Choice1Of5(minfo, methArgTys) -> @@ -3026,19 +3072,27 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra | Choice2Of5 (tinst, rfref, isSet) -> let res = match isSet, rfref.RecdField.IsStatic, argExprs.Length with + + // static setter | true, true, 1 -> - Some (mkStaticRecdFieldSet (rfref, tinst, argExprs.[0], m)) + Some (mkStaticRecdFieldSet (rfref, tinst, argExprs.[0], m)) + + // instance setter | true, false, 2 -> - // If we resolve to an instance field on a struct and we haven't yet taken - // the address of the object then go do that - if rfref.Tycon.IsStructOrEnumTycon && not (isByrefTy g (tyOfExpr g argExprs.[0])) then - let h = List.head argExprs - let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false DefinitelyMutates h None m - Some (wrap (mkRecdFieldSetViaExprAddr (h', rfref, tinst, argExprs.[1], m))) - else - Some (mkRecdFieldSetViaExprAddr (argExprs.[0], rfref, tinst, argExprs.[1], m)) + // If we resolve to an instance field on a struct and we haven't yet taken + // the address of the object then go do that + if rfref.Tycon.IsStructOrEnumTycon && not (isByrefTy g (tyOfExpr g argExprs.[0])) then + let h = List.head argExprs + let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false DefinitelyMutates h None m + Some (wrap (mkRecdFieldSetViaExprAddr (h', rfref, tinst, argExprs.[1], m))) + else + Some (mkRecdFieldSetViaExprAddr (argExprs.[0], rfref, tinst, argExprs.[1], m)) + + // static getter | false, true, 0 -> Some (mkStaticRecdFieldGet (rfref, tinst, m)) + + // instance getter | false, false, 1 -> if rfref.Tycon.IsStructOrEnumTycon && isByrefTy g (tyOfExpr g argExprs.[0]) then Some (mkRecdFieldGetViaExprAddr (argExprs.[0], rfref, tinst, m)) @@ -3046,6 +3100,7 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra Some (mkRecdFieldGet g (argExprs.[0], rfref, tinst, m)) | _ -> None ResultD res + | Choice3Of5 (anonInfo, tinst, i) -> let res = let tupInfo = anonInfo.TupInfo @@ -3055,9 +3110,11 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra Some (mkAnonRecdFieldGet g (anonInfo, argExprs.[0], tinst, i, m)) ResultD res - | Choice4Of5 expr -> ResultD (Some (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m))) + | Choice4Of5 expr -> + ResultD (Some (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m))) - | Choice5Of5 () -> ResultD None + | Choice5Of5 () -> + ResultD None } let ChooseTyparSolutionAndSolve css denv tp = diff --git a/src/fsharp/DependencyManager.Integration.fs b/src/fsharp/DependencyManager.Integration.fs index 9f1ecd35f3..453dcfa6a6 100644 --- a/src/fsharp/DependencyManager.Integration.fs +++ b/src/fsharp/DependencyManager.Integration.fs @@ -62,9 +62,9 @@ module ReflectionHelper = type internal IDependencyManagerProvider = abstract Name: string abstract Key: string - abstract ResolveDependencies: scriptDir: string * mainScriptName: string * scriptName: string * packageManagerTextLines: string seq * tfm: string -> bool * string list * string list + abstract ResolveDependencies: scriptExt: string * packageManagerTextLines: string seq * tfm: string -> bool * string list * string list abstract DependencyAdding: IEvent - abstract DependencyAdded: IEvent + abstract DependencyAdded: IEvent abstract DependencyFailed: IEvent [] @@ -86,7 +86,7 @@ type ReflectionDependencyManagerProvider(theType: Type, nameProperty: PropertyIn match ReflectionHelper.getAttributeNamed theType dependencyManagerAttributeName, ReflectionHelper.getInstanceProperty theType namePropertyName, ReflectionHelper.getInstanceProperty theType keyPropertyName, - ReflectionHelper.getInstanceMethod theType [| typeof; typeof; typeof; typeof; typeof |] resolveDependenciesMethodName + ReflectionHelper.getInstanceMethod theType [| typeof; typeof; typeof |] resolveDependenciesMethodName with | None, _, _, _ -> None | _, None, _, _ -> None @@ -96,23 +96,35 @@ type ReflectionDependencyManagerProvider(theType: Type, nameProperty: PropertyIn Some (fun () -> new ReflectionDependencyManagerProvider(theType, nameProperty, keyProperty, resolveDependenciesMethod, outputDir) :> IDependencyManagerProvider) interface IDependencyManagerProvider with + member __.Name = instance |> nameProperty + member __.Key = instance |> keyProperty - member this.ResolveDependencies(scriptDir, mainScriptName, scriptName, packageManagerTextLines, tfm) = + member this.ResolveDependencies(scriptDir, packageManagerTextLines, tfm) = + let key = (this :> IDependencyManagerProvider).Key let triggerEvent (evt: Event) = for prLine in packageManagerTextLines do evt.Trigger(key, prLine) triggerEvent dependencyAddingEvent - let arguments = [| box scriptDir; box mainScriptName; box scriptName; box packageManagerTextLines; box tfm |] + let arguments = [| box scriptDir; box packageManagerTextLines; box tfm |] let succeeded, generatedScripts, additionalIncludeFolders = resolveDeps.Invoke(instance, arguments) :?> _ - if succeeded then triggerEvent dependencyAddedEvent - else triggerEvent dependencyFailedEvent + + for prLine in packageManagerTextLines do + if succeeded then + dependencyAddedEvent.Trigger(key, prLine, generatedScripts, additionalIncludeFolders) + else + dependencyFailedEvent.Trigger(key, prLine) + succeeded, generatedScripts, additionalIncludeFolders + member __.DependencyAdding = dependencyAddingEvent.Publish + member __.DependencyAdded = dependencyAddedEvent.Publish + member __.DependencyFailed = dependencyFailedEvent.Publish + // Resolution Path = Location of FSharp.Compiler.Private.dll let assemblySearchPaths = lazy ( [ @@ -191,9 +203,9 @@ let tryFindDependencyManagerByKey (compilerTools: string list) (outputDir:string errorR(Error(FSComp.SR.packageManagerError(e.Message), m)) None -let resolve (packageManager:IDependencyManagerProvider) implicitIncludeDir mainScriptName fileName m packageManagerTextLines = +let resolve (packageManager:IDependencyManagerProvider) scriptExt m packageManagerTextLines = try - Some(packageManager.ResolveDependencies(implicitIncludeDir, mainScriptName, fileName, packageManagerTextLines, executionTfm)) + Some(packageManager.ResolveDependencies(scriptExt, packageManagerTextLines, executionTfm)) with e -> let e = ReflectionHelper.stripTieWrapper e errorR(Error(FSComp.SR.packageManagerError(e.Message), m)) diff --git a/src/fsharp/DependencyManager.Integration.fsi b/src/fsharp/DependencyManager.Integration.fsi index 62af44898d..3029da21b0 100644 --- a/src/fsharp/DependencyManager.Integration.fsi +++ b/src/fsharp/DependencyManager.Integration.fsi @@ -8,9 +8,9 @@ open FSharp.Compiler.Range type IDependencyManagerProvider = abstract Name: string abstract Key: string - abstract ResolveDependencies: scriptDir: string * mainScriptName: string * scriptName: string * packageManagerTextLines: string seq * tfm: string -> bool * string list * string list + abstract ResolveDependencies: scriptExt: string * packageManagerTextLines: string seq * tfm: string -> bool * string list * string list abstract DependencyAdding: IEvent - abstract DependencyAdded: IEvent + abstract DependencyAdded: IEvent abstract DependencyFailed: IEvent [] @@ -23,4 +23,4 @@ val tryFindDependencyManagerInPath: string list -> string option -> range -> str val tryFindDependencyManagerByKey: string list -> string option -> range -> string -> IDependencyManagerProvider option val removeDependencyManagerKey: string -> string -> string val createPackageManagerUnknownError: string list -> string option -> string -> range -> exn -val resolve: IDependencyManagerProvider -> string -> string -> string -> range -> string seq -> (bool * string list * string list) option +val resolve: IDependencyManagerProvider -> string -> range -> string seq -> (bool * string list * string list) option diff --git a/src/fsharp/DotNetFrameworkDependencies.fs b/src/fsharp/DotNetFrameworkDependencies.fs index a454ec8059..129f6eb92e 100644 --- a/src/fsharp/DotNetFrameworkDependencies.fs +++ b/src/fsharp/DotNetFrameworkDependencies.fs @@ -115,13 +115,19 @@ module internal FSharp.Compiler.DotNetFrameworkDependencies let desktopProductVersionMonikers = [| // major, minor, build, revision, moniker 4, 8, 3815, 0, "net48" + 4, 8, 3761, 0, "net48" 4, 7, 3190, 0, "net472" + 4, 7, 3062, 0, "net472" 4, 7, 2600, 0, "net471" + 4, 7, 2558, 0, "net471" 4, 7, 2053, 0, "net47" + 4, 7, 2046, 0, "net47" 4, 6, 1590, 0, "net462" + 4, 6, 57, 0, "net462" 4, 6, 1055, 0, "net461" 4, 6, 81, 0, "net46" 4, 0, 30319, 34209, "net452" + 4, 0, 30319, 17020, "net452" 4, 0, 30319, 18408, "net451" 4, 0, 30319, 17929, "net45" 4, 0, 30319, 1, "net4" @@ -138,14 +144,16 @@ module internal FSharp.Compiler.DotNetFrameworkDependencies with _ -> defaultMscorlibVersion // Get the ProductVersion of this framework compare with table yield compatible monikers - let _, _, _, _, moniker = + match desktopProductVersionMonikers - |> Array.find (fun (major, minor, build, revision, _) -> + |> Array.tryFind (fun (major, minor, build, revision, _) -> (majorPart >= major) && (minorPart >= minor) && (buildPart >= build) && - (privatePart >= revision)) - moniker + (privatePart >= revision)) with + | Some (_,_,_,_,moniker) -> moniker + | None -> // if no moniker can be found, assume latest stable? + "net48" /// Gets the tfm E.g netcore3.0, net472 let executionTfm = diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index de26c9b349..6a4e5da6b1 100755 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1475,6 +1475,9 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl 3301,chkInvalidFunctionReturnType,"The function or method has an invalid return type '%s'. This is not permitted by the rules of Common IL." 3302,packageManagementRequiresVFive,"The package management feature requires language version 5.0 use /langversion:preview" 3303,fromEndSlicingRequiresVFive,"From the end slicing with requires language version 5.0, use /langversion:preview." +3343,tcRequireMergeSourcesOrBindN,"The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '%s' method or appropriate 'MergeSource' and 'Bind' methods" +3344,tcAndBangNotSupported,"This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature." +3345,tcInvalidUseBangBindingNoAndBangs,"use! may not be combined with and!" useSdkRefs,"Use reference assemblies for .NET framework references when available (Enabled by default)." fSharpBannerVersion,"%s for F# %s" optsLangVersion,"Display the allowed values for language version, specify language version such as 'latest' or 'preview'" diff --git a/src/fsharp/FSStrings.resx b/src/fsharp/FSStrings.resx index cf3d3c92b2..a56e6f1421 100755 --- a/src/fsharp/FSStrings.resx +++ b/src/fsharp/FSStrings.resx @@ -564,6 +564,9 @@ keyword 'and' + ! + keyword 'and!' + keyword 'as' diff --git a/src/fsharp/FSharp.Compiler.Private.Scripting/FSharpScript.fs b/src/fsharp/FSharp.Compiler.Private.Scripting/FSharpScript.fs index 0ba6a72827..3106bc4c28 100644 --- a/src/fsharp/FSharp.Compiler.Private.Scripting/FSharpScript.fs +++ b/src/fsharp/FSharp.Compiler.Private.Scripting/FSharpScript.fs @@ -19,14 +19,8 @@ type FSharpScript(?additionalArgs: string[]) = let argv = Array.append baseArgs additionalArgs let fsi = FsiEvaluationSession.Create (config, argv, stdin, stdout, stderr) - [] - member __.AssemblyReferenceAdded = fsi.AssemblyReferenceAdded - member __.ValueBound = fsi.ValueBound - [] - member __.IncludePathAdded = fsi.IncludePathAdded - [] member __.DependencyAdding = fsi.DependencyAdding @@ -36,12 +30,6 @@ type FSharpScript(?additionalArgs: string[]) = [] member __.DependencyFailed = fsi.DependencyFailed - member __.ProvideInput = stdin.ProvideInput - - member __.OutputProduced = outputProduced.Publish - - member __.ErrorProduced = errorProduced.Publish - member __.Fsi = fsi member __.Eval(code: string, ?cancellationToken: CancellationToken) = diff --git a/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.ProjectFile.fs b/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.ProjectFile.fs new file mode 100644 index 0000000000..d39f0fab2c --- /dev/null +++ b/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.ProjectFile.fs @@ -0,0 +1,190 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +namespace FSharp.DependencyManager + +open System +open System.Collections +open System.Collections.Generic +open System.Diagnostics +open System.IO +open System.Reflection +open System.Runtime.CompilerServices +open System.Runtime.Versioning + +open Internal.Utilities.FSharpEnvironment + +// Package reference information +type PackageReference = { + Include:string + Version:string + RestoreSources:string + Script:string } + + +// Resolved assembly information +type Resolution = { + NugetPackageId : string + NugetPackageVersion : string + PackageRoot : string + FullPath : string + IsNotImplementationReference: string + NativePath : string + AppHostRuntimeIdentifier : string + InitializeSourcePath : string } + + +module ProjectFile = + + let findLoadsFromResolutions (resolutions:Resolution array) = + resolutions + |> Array.filter(fun r -> not(String.IsNullOrEmpty(r.NugetPackageId) || + String.IsNullOrEmpty(r.InitializeSourcePath)) && + File.Exists(r.InitializeSourcePath)) + |> Array.map(fun r -> r.InitializeSourcePath) + |> Array.distinct + + let findIncludesFromResolutions (resolutions:Resolution array) = + let managedRoots = + resolutions + |> Array.filter(fun r -> not(String.IsNullOrEmpty(r.NugetPackageId) || + String.IsNullOrEmpty(r.PackageRoot)) && + Directory.Exists(r.PackageRoot)) + |> Array.map(fun r -> r.PackageRoot) + |> Array.distinct + + let nativeRoots = + resolutions + |> Array.filter(fun r -> not(String.IsNullOrEmpty(r.NugetPackageId) || + String.IsNullOrEmpty(r.NativePath)) && + Directory.Exists(r.NativePath)) + |> Array.map(fun r -> r.NativePath) + |> Array.distinct + + Array.concat [|managedRoots; nativeRoots|] + + let getResolutionsFromFile resolutionsFile = + + let lines = + try + File.ReadAllText(resolutionsFile).Split([| '\r'; '\n'|], StringSplitOptions.None) + |> Array.filter(fun line -> not(String.IsNullOrEmpty(line))) + with + | _ -> [||] + + [| for line in lines do + let fields = line.Split(',') + if fields.Length < 8 then raise (new System.InvalidOperationException(sprintf "Internal error - Invalid resolutions file format '%s'" line)) + else { + NugetPackageId = fields.[0] + NugetPackageVersion = fields.[1] + PackageRoot = fields.[2] + FullPath = fields.[3] + IsNotImplementationReference = fields.[4] + InitializeSourcePath = fields.[5] + NativePath = fields.[6] + AppHostRuntimeIdentifier = fields.[7] + } + |] + + let makeScriptFromResolutions (resolutions:Resolution array) poundRprefix = + let expandReferences = + resolutions + |> Array.filter(fun r -> not(String.IsNullOrEmpty(r.NugetPackageId) || + String.IsNullOrEmpty(r.FullPath)) && + String.Compare(r.IsNotImplementationReference, "true", StringComparison.InvariantCultureIgnoreCase) <> 0 && + File.Exists(r.FullPath)) + |> Array.fold(fun acc r -> acc + poundRprefix + r.FullPath + "\"" + Environment.NewLine) "" + + let projectTemplate =""" +// Generated from #r "nuget:Package References" +// ============================================ +// +// DOTNET_HOST_PATH:(C:\Program Files\dotnet\dotnet.exe) +// MSBuildSDKsPath:(C:\Program Files\dotnet\sdk\3.1.200-preview-014883\Sdks) +// MSBuildExtensionsPath:(C:\Program Files\dotnet\sdk\3.1.200-preview-014883\) +// +// References +// +$(POUND_R) + +""" + projectTemplate.Replace("$(POUND_R)", expandReferences) + + let generateProjectBody = """ + + + + $(TARGETFRAMEWORK) + false + true + true + + + 4.7.0 + 4.7.1-* + + +$(PACKAGEREFERENCES) + + + + + <__InteractiveReferencedAssemblies Include = "@(ReferencePath)" /> + <__InteractiveReferencedAssembliesCopyLocal Include = "@(RuntimeCopyLocalItems)" Condition="'$(TargetFrameworkIdentifier)'!='.NETFramework'" /> + <__InteractiveReferencedAssembliesCopyLocal Include = "@(ReferenceCopyLocalPaths)" Condition="'$(TargetFrameworkIdentifier)'=='.NETFramework'" /> + <__ConflictsList Include="%(_ConflictPackageFiles.ConflictItemType)=%(_ConflictPackageFiles.Filename)%(_ConflictPackageFiles.Extension)" /> + + + + <__Conflicts>@(__ConflictsList, ';'); + + + + + $([System.String]::Copy('%(Identity)').Replace('\', '/')) + $([System.String]::Copy('%(__InteractiveReferencedAssemblies.PathInPackage)').Replace('\', '/')) + $([System.String]::Copy('%(InteractiveResolvedFile.NormalizedIdentity)').IndexOf('%(InteractiveResolvedFile.NormalizedPathInPackage)')) + $([System.String]::Copy('%(InteractiveResolvedFile.NormalizedIdentity)').Substring(0, %(InteractiveResolvedFile.PositionPathInPackage))) + %(InteractiveResolvedFile.PackageRoot)content\%(__InteractiveReferencedAssemblies.FileName)%(__InteractiveReferencedAssemblies.Extension)$(SCRIPTEXTENSION) + $([System.String]::Copy('%(__InteractiveReferencedAssemblies.PathInPackage)').StartsWith('ref/')) + %(__InteractiveReferencedAssemblies.NuGetPackageId) + %(__InteractiveReferencedAssemblies.NuGetPackageVersion) + + + + $([System.String]::Copy('%(Identity)').Replace('\', '/')) + $([System.String]::Copy('%(__InteractiveReferencedAssembliesCopyLocal.PathInPackage)').Replace('\', '/')) + $([System.String]::Copy('%(InteractiveResolvedFile.NormalizedIdentity)').IndexOf('%(InteractiveResolvedFile.NormalizedPathInPackage)')) + $([System.String]::Copy('%(InteractiveResolvedFile.NormalizedIdentity)').Substring(0, %(InteractiveResolvedFile.PositionPathInPackage))) + %(InteractiveResolvedFile.PackageRoot)content\%(__InteractiveReferencedAssembliesCopyLocal.FileName)%(__InteractiveReferencedAssembliesCopyLocal.Extension)$(SCRIPTEXTENSION) + $([System.String]::Copy('%(__InteractiveReferencedAssembliesCopyLocal.PathInPackage)').StartsWith('ref/')) + %(__InteractiveReferencedAssembliesCopyLocal.NuGetPackageId) + %(__InteractiveReferencedAssembliesCopyLocal.NuGetPackageVersion) + + + + $([MSBuild]::EnsureTrailingSlash('$([System.String]::Copy('%(FullPath)').Substring(0, $([System.String]::Copy('%(FullPath)').LastIndexOf('runtimes'))))')) + + + + + + + + + + + + + + +""" diff --git a/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.Utilities.fs b/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.Utilities.fs index d86ceb3dbb..2f13ac26e4 100644 --- a/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.Utilities.fs +++ b/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.Utilities.fs @@ -10,20 +10,16 @@ open System.Reflection open System.Runtime.CompilerServices open System.Runtime.Versioning +open FSharp.DependencyManager.ProjectFile open Internal.Utilities.FSharpEnvironment -#if !(NETSTANDARD || NETCOREAPP) -open Microsoft.Build.Evaluation -open Microsoft.Build.Framework -#endif - [] type DependencyManagerAttribute() = inherit System.Attribute() module Utilities = /// Return a string array delimited by commas - /// Note that a quoted string is not going to be mangled into pieces. + /// Note that a quoted string is not going to be mangled into pieces. let trimChars = [| ' '; '\t'; '\''; '\"' |] let inline private isNotQuotedQuotation (text: string) n = n > 0 && text.[n-1] <> '\\' @@ -86,7 +82,6 @@ module Utilities = let sdks = "Sdks" -#if !(NETSTANDARD || NETCOREAPP) let msbuildExePath = // Find msbuild.exe when invoked from desktop compiler. // 1. Look relative to F# compiler location Normal retail build @@ -120,7 +115,7 @@ module Utilities = | _ -> None roots |> Array.tryFind(fun root -> msbuildPathExists root) |> msbuildOption -#else + let dotnetHostPath = // How to find dotnet.exe --- woe is me; probing rules make me sad. // Algorithm: @@ -156,7 +151,6 @@ module Utilities = Some dotnet else None -#endif let drainStreamToFile (stream: StreamReader) filename = use file = File.OpenWrite(filename) @@ -172,7 +166,6 @@ module Utilities = let executeBuild pathToExe arguments workingDir = match pathToExe with | Some path -> - let psi = ProcessStartInfo() psi.FileName <- path psi.WorkingDirectory <- workingDir @@ -186,10 +179,21 @@ module Utilities = p.StartInfo <- psi p.Start() |> ignore - drainStreamToFile p.StandardOutput (Path.Combine(workingDir, "StandardOutput.txt")) - drainStreamToFile p.StandardError (Path.Combine(workingDir, "StandardError.txt")) + let standardOutput = Path.Combine(workingDir, "StandardOutput.txt") + let standardError = Path.Combine(workingDir, "StandardError.txt") + drainStreamToFile p.StandardOutput (Path.Combine(workingDir, standardOutput)) + drainStreamToFile p.StandardError (Path.Combine(workingDir, standardError)) p.WaitForExit() + if p.ExitCode <> 0 then + //Write StandardError.txt to err stream + let text = File.ReadAllText(standardOutput) + Console.Out.Write(text) + + //Write StandardOutput.txt to out stream + let text = File.ReadAllText(standardError) + Console.Out.Write(text) + p.ExitCode = 0 | None -> false @@ -210,134 +214,13 @@ module Utilities = let workingDir = Path.GetDirectoryName projectPath let succeeded = -#if !(NETSTANDARD || NETCOREAPP) - // The Desktop build uses "msbuild" to build - executeBuild msbuildExePath (arguments "") workingDir -#else - // The coreclr uses "dotnet msbuild" to build - executeBuild dotnetHostPath (arguments "msbuild") workingDir -#endif - let outputFile = projectPath + ".fsx" + if not (isRunningOnCoreClr) then + // The Desktop build uses "msbuild" to build + executeBuild msbuildExePath (arguments "") workingDir + else + // The coreclr uses "dotnet msbuild" to build + executeBuild dotnetHostPath (arguments "msbuild") workingDir + + let outputFile = projectPath + ".resolvedReferences.paths" let resultOutFile = if succeeded && File.Exists(outputFile) then Some outputFile else None succeeded, resultOutFile - - // Generate a project files for dependencymanager projects - let generateLibrarySource = @"// Generated dependencymanager library -namespace lib" - - let generateProjectBody = @" - - - $(TARGETFRAMEWORK) - false - - - 4.7.0 - 4.7.1-* - - - - -$(PACKAGEREFERENCES) - - - - - - - - - - - - fsharp41 - tools - - - - - - - <_ResolvedOutputFiles - Include=""%(_ResolvedProjectReferencePaths.RootDir)%(_ResolvedProjectReferencePaths.Directory)/**/*"" - Exclude=""%(_ResolvedProjectReferencePaths.RootDir)%(_ResolvedProjectReferencePaths.Directory)/**/FSharp.Core.dll;%(_ResolvedProjectReferencePaths.RootDir)%(_ResolvedProjectReferencePaths.Directory)/**/System.ValueTuple.dll"" - Condition=""'%(_ResolvedProjectReferencePaths.IsFSharpDesignTimeProvider)' == 'true'""> - %(_ResolvedProjectReferencePaths.NearestTargetFramework) - - - <_ResolvedOutputFiles - Include=""@(BuiltProjectOutputGroupKeyOutput)"" - Condition=""'$(IsFSharpDesignTimeProvider)' == 'true' and '%(BuiltProjectOutputGroupKeyOutput->Filename)%(BuiltProjectOutputGroupKeyOutput->Extension)' != 'FSharp.Core.dll' and '%(BuiltProjectOutputGroupKeyOutput->Filename)%(BuiltProjectOutputGroupKeyOutput->Extension)' != 'System.ValueTuple.dll'""> - $(TargetFramework) - - - - $(FSharpToolsDirectory)/$(FSharpDesignTimeProtocol)/%(_ResolvedOutputFiles.NearestTargetFramework)/%(_ResolvedOutputFiles.FileName)%(_ResolvedOutputFiles.Extension) - - - - - - - - - $([System.String]::Copy('%(Identity)').Replace('\', '/')) - $([System.String]::Copy('%(ResolvedCompileFileDefinitions.PathInPackage)').Replace('\', '/')) - $([System.String]::Copy('%(InteractiveResolvedFile.NormalizedIdentity)').IndexOf('%(InteractiveResolvedFile.NormalizedPathInPackage)')) - $([System.String]::Copy('%(InteractiveResolvedFile.NormalizedIdentity)').Substring(0, %(InteractiveResolvedFile.PositionPathInPackage))) - %(InteractiveResolvedFile.PackageRoot)content\%(ResolvedCompileFileDefinitions.FileName)%(ResolvedCompileFileDefinitions.Extension).fsx - $([System.String]::Copy('%(ResolvedCompileFileDefinitions.PathInPackage)').StartsWith('ref/')) - %(ResolvedCompileFileDefinitions.NuGetPackageId) - %(ResolvedCompileFileDefinitions.NuGetPackageVersion) - - - $([System.String]::Copy('%(Identity)').Replace('\', '/')) - $([System.String]::Copy('%(RuntimeCopyLocalItems.PathInPackage)').Replace('\', '/')) - $([System.String]::Copy('%(InteractiveResolvedFile.NormalizedIdentity)').IndexOf('%(InteractiveResolvedFile.NormalizedPathInPackage)')) - $([System.String]::Copy('%(InteractiveResolvedFile.NormalizedIdentity)').Substring(0, %(InteractiveResolvedFile.PositionPathInPackage))) - %(InteractiveResolvedFile.PackageRoot)content\%(RuntimeCopyLocalItems.FileName)%(RuntimeCopyLocalItems.Extension).fsx - $([System.String]::Copy('%(RuntimeCopyLocalItems.PathInPackage)').StartsWith('ref/')) - %(RuntimeCopyLocalItems.NuGetPackageId) - %(RuntimeCopyLocalItems.NuGetPackageVersion) - - - $([MSBuild]::EnsureTrailingSlash('$([System.String]::Copy('%(FullPath)').Substring(0, $([System.String]::Copy('%(FullPath)').LastIndexOf('runtimes'))))')) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -" diff --git a/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.fs b/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.fs index 9c577e9ca8..c2bf63c88d 100644 --- a/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.fs +++ b/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.fs @@ -8,15 +8,14 @@ open System.Diagnostics open System.IO open FSharp.DependencyManager open FSharp.DependencyManager.Utilities +open FSharp.DependencyManager.ProjectFile -module Attributes = - [] - do () - -type PackageReference = { Include:string; Version:string; RestoreSources:string; Script:string } module FSharpDependencyManager = + [] + do () + let private concat (s:string) (v:string) : string = match String.IsNullOrEmpty(s), String.IsNullOrEmpty(v) with | false, false -> s + ";" + v @@ -28,10 +27,10 @@ module FSharpDependencyManager = let { Include=inc; Version=ver; RestoreSources=src; Script=script } = p seq { match not (String.IsNullOrEmpty(inc)), not (String.IsNullOrEmpty(ver)), not (String.IsNullOrEmpty(script)) with - | true, true, false -> yield sprintf @" true" inc ver - | true, true, true -> yield sprintf @" true" inc ver script - | true, false, false -> yield sprintf @" true" inc - | true, false, true -> yield sprintf @" true" inc script + | true, true, false -> yield sprintf @" " inc ver + | true, true, true -> yield sprintf @" " inc ver script + | true, false, false -> yield sprintf @" " inc + | true, false, true -> yield sprintf @" " inc script | _ -> () match not (String.IsNullOrEmpty(src)) with | true -> yield sprintf @" %s" (concat "$(RestoreAdditionalProjectSources)" src) @@ -107,7 +106,9 @@ type [] FSharpDependencyManager (outputDir:string op match outputDir with | None -> path | Some v -> Path.Combine(path, v) + let generatedScripts = new ConcurrentDictionary() + let deleteScripts () = try if Directory.Exists(scriptsPath) then @@ -134,8 +135,12 @@ type [] FSharpDependencyManager (outputDir:string op member __.Key = key - member __.ResolveDependencies(_scriptDir:string, _mainScriptName:string, _scriptName:string, packageManagerTextLines:string seq, tfm: string) : bool * string list * string list = + member __.ResolveDependencies(scriptExt:string, packageManagerTextLines:string seq, tfm: string) : bool * string list * string list = + let scriptExt, poundRprefix = + match scriptExt with + | ".csx" -> ".csx", "#r \"" + | _ -> ".fsx", "#r @\"" let packageReferences, binLogPath = packageManagerTextLines |> List.ofSeq @@ -152,21 +157,28 @@ type [] FSharpDependencyManager (outputDir:string op if not (generatedScripts.ContainsKey(body.GetHashCode().ToString())) then emitFile path body - let fsProjectPath = Path.Combine(scriptsPath, "Project.fsproj") + let projectPath = Path.Combine(scriptsPath, "Project.fsproj") let generateProjBody = generateProjectBody.Replace("$(TARGETFRAMEWORK)", tfm) .Replace("$(PACKAGEREFERENCES)", packageReferenceText) - - writeFile (Path.Combine(scriptsPath, "Library.fs")) generateLibrarySource - writeFile fsProjectPath generateProjBody - - let succeeded, resultingFsx = buildProject fsProjectPath binLogPath - let fsx = - match resultingFsx with - | Some fsx -> [fsx] - | None -> [] - - succeeded, fsx, List.empty + .Replace("$(SCRIPTEXTENSION)", scriptExt) + + writeFile projectPath generateProjBody + + let result, resolutionsFile = buildProject projectPath binLogPath + match resolutionsFile with + | Some file -> + let resolutions = getResolutionsFromFile file + let scripts = + let scriptPath = projectPath + scriptExt + let scriptBody = makeScriptFromResolutions resolutions poundRprefix + emitFile scriptPath scriptBody + let loads = (findLoadsFromResolutions resolutions) |> Array.toList + List.concat [ [scriptPath]; loads] + let includes = (findIncludesFromResolutions resolutions) |> Array.toList + + result, scripts, includes + | None -> result, [], [] generateAndBuildProjectArtifacts diff --git a/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.fsproj b/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.fsproj index 7faf2884f4..8836a4cf62 100644 --- a/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.fsproj +++ b/src/fsharp/FSharp.DependencyManager/FSharp.DependencyManager.fsproj @@ -4,8 +4,7 @@ Library - net472;netstandard2.0 - netstandard2.0 + netstandard2.0 FSharp.DependencyManager $(NoWarn);45;55;62;75;1204 true @@ -19,21 +18,12 @@ $(BaseOutputPath)\$(Configuration)\$(TargetFramework) - - - - - - - - - - + @@ -41,18 +31,6 @@ - - - - - - - - - - - - diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 412d1a62ac..5d18e0d549 100755 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -3950,7 +3950,7 @@ and GenDefaultValue cenv cgbuf eenv (ty, m) = if isRefTy g ty then CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) AI_ldnull else - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref when (tyconRefEq g g.system_SByte_tcref tcref || tyconRefEq g g.system_Int16_tcref tcref || tyconRefEq g g.system_Int32_tcref tcref || diff --git a/src/fsharp/InfoReader.fs b/src/fsharp/InfoReader.fs index 1fac7a0f6e..1679f46c92 100644 --- a/src/fsharp/InfoReader.fs +++ b/src/fsharp/InfoReader.fs @@ -78,7 +78,7 @@ let rec GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m origTy GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m origTy betterMetadataTy |> List.filter (fun minfo -> not minfo.IsInstance) else - match tryDestAppTy g metadataTy with + match tryTcrefOfAppTy g metadataTy with | ValueNone -> [] | ValueSome tcref -> SelectImmediateMemberVals g optFilter (TrySelectMemberVal g optFilter origTy None) tcref @@ -166,7 +166,7 @@ let rec GetImmediateIntrinsicPropInfosOfTypeAux (optFilter, ad) g amap m origTy let betterMetadataTy = convertToTypeWithMetadataIfPossible g metadataTy GetImmediateIntrinsicPropInfosOfTypeAux (optFilter, ad) g amap m origTy betterMetadataTy else - match tryDestAppTy g metadataTy with + match tryTcrefOfAppTy g metadataTy with | ValueNone -> [] | ValueSome tcref -> let propCollector = new PropertyCollector(g, amap, m, origTy, optFilter, ad) @@ -185,7 +185,7 @@ let rec GetImmediateIntrinsicPropInfosOfType (optFilter, ad) g amap m ty = let IsIndexerType g amap ty = isArray1DTy g ty || isListTy g ty || - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> let _, entityTy = generalizeTyconRef tcref let props = GetImmediateIntrinsicPropInfosOfType (None, AccessibleFromSomeFSharpCode) g amap range0 entityTy @@ -265,7 +265,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = /// Get the F#-declared record fields or class 'val' fields of a type let GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, _ad) _m ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueNone -> [] | ValueSome tcref -> // Note;secret fields are not allowed in lookups here, as we're only looking @@ -420,7 +420,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = | flds -> // multiple fields with the same name can come from different classes, // so filter them by the given type name - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueNone -> ValueNone | ValueSome tcref -> match flds |> List.filter (fun rfinfo -> tyconRefEq g tcref rfinfo.TyconRef) with @@ -466,7 +466,7 @@ let rec GetIntrinsicConstructorInfosOfTypeAux (infoReader: InfoReader) m origTy let betterMetadataTy = convertToTypeWithMetadataIfPossible g metadataTy GetIntrinsicConstructorInfosOfTypeAux infoReader m origTy betterMetadataTy else - match tryDestAppTy g metadataTy with + match tryTcrefOfAppTy g metadataTy with | ValueNone -> [] | ValueSome tcref -> tcref.MembersOfFSharpTyconByName diff --git a/src/fsharp/LanguageFeatures.fs b/src/fsharp/LanguageFeatures.fs index 2170cee8f7..9d23f9e266 100644 --- a/src/fsharp/LanguageFeatures.fs +++ b/src/fsharp/LanguageFeatures.fs @@ -28,6 +28,7 @@ type LanguageFeature = | PackageManagement | FromEndSlicing | FixedIndexSlice3d4d + | AndBang /// LanguageVersion management type LanguageVersion (specifiedVersionAsString) = @@ -61,6 +62,7 @@ type LanguageVersion (specifiedVersionAsString) = LanguageFeature.NameOf, previewVersion LanguageFeature.OpenStaticClasses, previewVersion LanguageFeature.PackageManagement, previewVersion + LanguageFeature.AndBang, previewVersion ] let specified = diff --git a/src/fsharp/LanguageFeatures.fsi b/src/fsharp/LanguageFeatures.fsi index 6b44cd878a..5f274351d7 100644 --- a/src/fsharp/LanguageFeatures.fsi +++ b/src/fsharp/LanguageFeatures.fsi @@ -16,6 +16,7 @@ type LanguageFeature = | PackageManagement | FromEndSlicing | FixedIndexSlice3d4d + | AndBang /// LanguageVersion management type LanguageVersion = diff --git a/src/fsharp/LegacyMSBuildReferenceResolver.fs b/src/fsharp/LegacyMSBuildReferenceResolver.fs index a07941509f..c0f2596c39 100644 --- a/src/fsharp/LegacyMSBuildReferenceResolver.fs +++ b/src/fsharp/LegacyMSBuildReferenceResolver.fs @@ -344,7 +344,7 @@ module LegacyMSBuildReferenceResolver #if ENABLE_MONO_SUPPORT // The properties TargetedRuntimeVersion and CopyLocalDependenciesWhenParentReferenceInGac // are not available on Mono. So we only set them if available (to avoid a compile-time dependency). - if not FSharp.Compiler.AbstractIL.IL.runningOnMono then + if not FSharp.Compiler.AbstractIL.Internal.Utils.runningOnMono then typeof.InvokeMember("TargetedRuntimeVersion",(BindingFlags.Instance ||| BindingFlags.SetProperty ||| BindingFlags.Public),null,rar,[| box targetedRuntimeVersionValue |]) |> ignore typeof.InvokeMember("CopyLocalDependenciesWhenParentReferenceInGac",(BindingFlags.Instance ||| BindingFlags.SetProperty ||| BindingFlags.Public),null,rar,[| box true |]) |> ignore #else diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs old mode 100755 new mode 100644 index 470b54709b..d485399af8 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -1784,6 +1784,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, pushCtxt tokenTup (CtxtLetDecl(blockLet, tokenStartPos)) returnToken tokenLexbufState (if blockLet then OBINDER b else token) + // and! ... ~~~> CtxtLetDecl + | AND_BANG isUse, (ctxt :: _) -> + let blockLet = match ctxt with CtxtSeqBlock _ -> true | _ -> false + if debug then dprintf "AND!: entering CtxtLetDecl(blockLet=%b), awaiting EQUALS to go to CtxtSeqBlock (%a)\n" blockLet outputPos tokenStartPos + pushCtxt tokenTup (CtxtLetDecl(blockLet,tokenStartPos)) + returnToken tokenLexbufState (if blockLet then OAND_BANG isUse else token) + | (VAL | STATIC | ABSTRACT | MEMBER | OVERRIDE | DEFAULT), ctxtStack when thereIsACtxtMemberBodyOnTheStackAndWeShouldPopStackForUpcomingMember ctxtStack -> if debug then dprintf "STATIC/MEMBER/OVERRIDE/DEFAULT: already inside CtxtMemberBody, popping all that context before starting next member...\n" // save this token, we'll consume it again later... diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index a63c8e6e13..8f3c6863c1 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -536,7 +536,7 @@ let ExtensionPropInfosOfTypeInScope collectionSettings (infoReader:InfoReader) ( let extMemsFromHierarchy = infoReader.GetEntireTypeHierarchy(AllowMultiIntfInstantiations.Yes, m, ty) |> List.collect (fun ty -> - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> let extMemInfos = nenv.eIndexedExtensionMembers.Find tcref SelectPropInfosFromExtMembers infoReader ad optFilter ty m extMemInfos @@ -606,7 +606,7 @@ let ExtensionMethInfosOfTypeInScope (collectionSettings: ResultCollectionSetting infoReader.GetEntireTypeHierarchy(AllowMultiIntfInstantiations.Yes, m, ty) |> List.collect (fun ty -> let g = infoReader.g - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> let extValRefs = nenv.eIndexedExtensionMembers.Find tcref SelectMethInfosFromExtMembers infoReader optFilter ty m extValRefs @@ -2352,7 +2352,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf match lookupKind with | LookupKind.Expr | LookupKind.Pattern -> - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> for uc in tcref.UnionCasesArray do addToBuffer uc.DisplayName @@ -2365,7 +2365,7 @@ and ResolveLongIdentInNestedTypes (ncenv: NameResolver) nenv lookupKind resInfo tys |> CollectAtMostOneResult (fun ty -> let resInfo = - match tryDestAppTy ncenv.g ty with + match tryTcrefOfAppTy ncenv.g ty with | ValueSome tcref -> resInfo.AddEntity(id.idRange, tcref) | _ -> @@ -3222,7 +3222,7 @@ let ResolveFieldPrim sink (ncenv: NameResolver) nenv ad ty (mp, id: Ident) allFi |> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) |> List.map (fun x -> ResolutionInfo.Empty, FieldResolution(x, false)) - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText, m, ty) with | ValueSome (RecdFieldInfo(_, rfref)) -> [ResolutionInfo.Empty, FieldResolution(rfref, false)] @@ -3536,7 +3536,7 @@ let ItemOfTyconRef ncenv m (x: TyconRef) = let ItemOfTy g x = let nm = - match tryDestAppTy g x with + match tryTcrefOfAppTy g x with | ValueSome tcref -> tcref.DisplayName | _ -> "?" Item.Types (nm, [x]) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 6c5cc67e5a..915db6e45c 100755 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -255,7 +255,7 @@ let RefuteDiscrimSet g m path discrims = match c' with | None -> raise CannotRefute | Some c -> - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref when tcref.IsEnumTycon -> // We must distinguish between F#-defined enums and other .NET enums, as they are represented differently in the TAST let enumValues = diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index aedf7252d9..35bf453212 100755 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -477,7 +477,7 @@ let CheckTypeForAccess (cenv: cenv) env objName valAcc m ty = let visitType ty = // We deliberately only check the fully stripped type for accessibility, // because references to private type abbreviations are permitted - match tryDestAppTy cenv.g ty with + match tryTcrefOfAppTy cenv.g ty with | ValueNone -> () | ValueSome tcref -> let thisCompPath = compPathOfCcu cenv.viewCcu @@ -493,7 +493,7 @@ let WarnOnWrongTypeForAccess (cenv: cenv) env objName valAcc m ty = let visitType ty = // We deliberately only check the fully stripped type for accessibility, // because references to private type abbreviations are permitted - match tryDestAppTy cenv.g ty with + match tryTcrefOfAppTy cenv.g ty with | ValueNone -> () | ValueSome tcref -> let thisCompPath = compPathOfCcu cenv.viewCcu @@ -618,7 +618,7 @@ let CheckTypeAux permitByRefLike (cenv: cenv) env m ty onInnerByrefError = let visitAppTy (tcref, tinst) = if isByrefLikeTyconRef cenv.g m tcref then let visitType ty0 = - match tryDestAppTy cenv.g ty0 with + match tryTcrefOfAppTy cenv.g ty0 with | ValueNone -> () | ValueSome tcref2 -> if isByrefTyconRef cenv.g tcref2 then @@ -1024,7 +1024,7 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi when not virt && baseVal.BaseOrThisInfo = BaseVal -> // Disallow calls to abstract base methods on IL types. - match tryDestAppTy g baseVal.Type with + match tryTcrefOfAppTy g baseVal.Type with | ValueSome tcref when tcref.IsILTycon -> try // This is awkward - we have to explicitly re-resolve back to the IL metadata to determine if the method is abstract. diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 3d474dadbc..a2d6a10a88 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -248,12 +248,14 @@ and remapTyparConstraintsAux tyenv cs = Some(TyparConstraint.CoercesTo (remapTypeAux tyenv ty, m)) | TyparConstraint.MayResolveMember(traitInfo, m) -> Some(TyparConstraint.MayResolveMember (remapTraitAux tyenv traitInfo, m)) - | TyparConstraint.DefaultsTo(priority, ty, m) -> Some(TyparConstraint.DefaultsTo(priority, remapTypeAux tyenv ty, m)) + | TyparConstraint.DefaultsTo(priority, ty, m) -> + Some(TyparConstraint.DefaultsTo(priority, remapTypeAux tyenv ty, m)) | TyparConstraint.IsEnum(uty, m) -> Some(TyparConstraint.IsEnum(remapTypeAux tyenv uty, m)) | TyparConstraint.IsDelegate(uty1, uty2, m) -> Some(TyparConstraint.IsDelegate(remapTypeAux tyenv uty1, remapTypeAux tyenv uty2, m)) - | TyparConstraint.SimpleChoice(tys, m) -> Some(TyparConstraint.SimpleChoice(remapTypesAux tyenv tys, m)) + | TyparConstraint.SimpleChoice(tys, m) -> + Some(TyparConstraint.SimpleChoice(remapTypesAux tyenv tys, m)) | TyparConstraint.SupportsComparison _ | TyparConstraint.SupportsEquality _ | TyparConstraint.SupportsNull _ @@ -824,7 +826,7 @@ let tcrefOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> let argsOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(_, tinst) -> tinst | _ -> []) let tryDestTyparTy g ty = ty |> stripTyEqns g |> (function TType_var v -> ValueSome v | _ -> ValueNone) let tryDestFunTy g ty = ty |> stripTyEqns g |> (function TType_fun (tyv, tau) -> ValueSome(tyv, tau) | _ -> ValueNone) -let tryDestAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> ValueSome tcref | _ -> ValueNone) +let tryTcrefOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> ValueSome tcref | _ -> ValueNone) let tryDestAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon (anonInfo, tys) -> ValueSome (anonInfo, tys) | _ -> ValueNone) let tryAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var v -> ValueSome v | TType_measure unt when isUnitParMeasure g unt -> ValueSome(destUnitParMeasure g unt) | _ -> ValueNone) @@ -1705,17 +1707,17 @@ let isFSharpObjModelRefTy g ty = | TTyconStruct | TTyconEnum -> false let isFSharpClassTy g ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> tcref.Deref.IsFSharpClassTycon | _ -> false let isFSharpStructTy g ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> tcref.Deref.IsFSharpStructOrEnumTycon | _ -> false let isFSharpInterfaceTy g ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> tcref.Deref.IsFSharpInterfaceTycon | _ -> false @@ -1726,7 +1728,7 @@ let isDelegateTy g ty = #endif | ILTypeMetadata (TILObjectReprData(_, _, td)) -> td.IsDelegate | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> tcref.Deref.IsFSharpDelegateTycon | _ -> false @@ -1747,12 +1749,12 @@ let isClassTy g ty = | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> isFSharpClassTy g ty let isStructOrEnumTyconTy g ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> tcref.Deref.IsStructOrEnumTycon | _ -> false let isStructRecordOrUnionTyconTy g ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> tcref.Deref.IsStructRecordOrUnionTycon | _ -> false @@ -1761,7 +1763,7 @@ let isStructTyconRef (tcref: TyconRef) = tycon.IsStructRecordOrUnionTycon || tycon.IsStructOrEnumTycon let isStructTy g ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> isStructTyconRef tcref | _ -> @@ -1792,7 +1794,7 @@ let isRefTy g ty = // [Note: Constructed types and type-parameters are never unmanaged-types. end note] let rec isUnmanagedTy g ty = let ty = stripTyEqnsAndMeasureEqns g ty - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> let isEq tcref2 = tyconRefEq g tcref tcref2 if isEq g.nativeptr_tcr || isEq g.nativeint_tcr || @@ -1824,7 +1826,7 @@ let isInterfaceTycon x = let isInterfaceTyconRef (tcref: TyconRef) = isInterfaceTycon tcref.Deref let isEnumTy g ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueNone -> false | ValueSome tcref -> tcref.IsEnumTycon @@ -3082,7 +3084,7 @@ let destNativePtrTy g ty = | _ -> failwith "destNativePtrTy: not a native ptr type" let isRefCellTy g ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueNone -> false | ValueSome tcref -> tyconRefEq g g.refcell_tcr_canon tcref @@ -3107,7 +3109,7 @@ let mkOptionTy (g: TcGlobals) ty = TType_app (g.option_tcr_nice, [ty]) let mkListTy (g: TcGlobals) ty = TType_app (g.list_tcr_nice, [ty]) let isOptionTy (g: TcGlobals) ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueNone -> false | ValueSome tcref -> tyconRefEq g g.option_tcr_canon tcref @@ -3122,7 +3124,7 @@ let destOptionTy g ty = | ValueNone -> failwith "destOptionTy: not an option type" let isNullableTy (g: TcGlobals) ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueNone -> false | ValueSome tcref -> tyconRefEq g g.system_Nullable_tcref tcref @@ -3147,7 +3149,7 @@ let (|StripNullableTy|) g ty = | _ -> ty let isLinqExpressionTy g ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueNone -> false | ValueSome tcref -> tyconRefEq g g.system_LinqExpression_tcref tcref @@ -4875,7 +4877,7 @@ let decideStaticOptimizationConstraint g c = checkTypes a b | TTyconIsStruct a -> let a = normalizeEnumTy g (stripTyEqnsAndMeasureEqns g a) - match tryDestAppTy g a with + match tryTcrefOfAppTy g a with | ValueSome tcref1 -> if tcref1.IsStructOrEnumTycon then StaticOptimizationAnswer.Yes else StaticOptimizationAnswer.No | ValueNone -> StaticOptimizationAnswer.Unknown @@ -5984,7 +5986,7 @@ let isRecdOrStructTyconRefReadOnly g m tcref = isRecdOrStructTyconRefReadOnlyAux g m false tcref let isRecdOrStructTyReadOnlyAux (g: TcGlobals) m isInref ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueNone -> false | ValueSome tcref -> isRecdOrStructTyconRefReadOnlyAux g m isInref tcref @@ -6530,7 +6532,7 @@ let mkMinusOne g m = mkInt g m (-1) let destInt32 = function Expr.Const (Const.Int32 n, _, _) -> Some n | _ -> None let isIDelegateEventType g ty = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> tyconRefEq g g.fslib_IDelegateEvent_tcr tcref | _ -> false @@ -7954,15 +7956,15 @@ let TypeNullNever g ty = let TypeNullIsExtraValue g m ty = if isILReferenceTy g ty || isDelegateTy g ty then // Putting AllowNullLiteralAttribute(false) on an IL or provided type means 'null' can't be used with that type - not (match tryDestAppTy g ty with ValueSome tcref -> TryFindTyconRefBoolAttribute g m g.attrib_AllowNullLiteralAttribute tcref = Some false | _ -> false) + not (match tryTcrefOfAppTy g ty with ValueSome tcref -> TryFindTyconRefBoolAttribute g m g.attrib_AllowNullLiteralAttribute tcref = Some false | _ -> false) elif TypeNullNever g ty then false else // Putting AllowNullLiteralAttribute(true) on an F# type means 'null' can be used with that type - match tryDestAppTy g ty with ValueSome tcref -> TryFindTyconRefBoolAttribute g m g.attrib_AllowNullLiteralAttribute tcref = Some true | _ -> false + match tryTcrefOfAppTy g ty with ValueSome tcref -> TryFindTyconRefBoolAttribute g m g.attrib_AllowNullLiteralAttribute tcref = Some true | _ -> false let TypeNullIsTrueValue g ty = - (match tryDestAppTy g ty with + (match tryTcrefOfAppTy g ty with | ValueSome tcref -> IsUnionTypeWithNullAsTrueValue g tcref.Deref | _ -> false) || (isUnitTy g ty) diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi index 176f64df72..332d98b35f 100755 --- a/src/fsharp/TastOps.fsi +++ b/src/fsharp/TastOps.fsi @@ -668,7 +668,7 @@ val destAppTy : TcGlobals -> TType -> TyconRef * TypeInst val tcrefOfAppTy : TcGlobals -> TType -> TyconRef -val tryDestAppTy : TcGlobals -> TType -> ValueOption +val tryTcrefOfAppTy : TcGlobals -> TType -> ValueOption val tryDestTyparTy : TcGlobals -> TType -> ValueOption diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs old mode 100644 new mode 100755 index c888057686..510b0542b7 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -1556,7 +1556,7 @@ let MakeAndPublishBaseVal cenv env baseIdOpt ty = let InstanceMembersNeedSafeInitCheck cenv m thisTy = ExistsInEntireHierarchyOfType - (fun ty -> not (isStructTy cenv.g ty) && (match tryDestAppTy cenv.g ty with ValueSome tcref when tcref.HasSelfReferentialConstructor -> true | _ -> false)) + (fun ty -> not (isStructTy cenv.g ty) && (match tryTcrefOfAppTy cenv.g ty with ValueSome tcref when tcref.HasSelfReferentialConstructor -> true | _ -> false)) cenv.g cenv.amap m @@ -1842,31 +1842,25 @@ let UseCombinedArity g declKind rhsExpr prelimScheme = let UseNoArity prelimScheme = BuildValScheme ExpressionBinding None prelimScheme -let MakeSimpleVals cenv env names = +/// Make and publish the Val nodes for a collection of simple (non-generic) value specifications +let MakeAndPublishSimpleVals cenv env names = let tyschemes = DontGeneralizeVals names let valSchemes = NameMap.map UseNoArity tyschemes let values = MakeAndPublishVals cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valSchemes, [], XmlDoc.Empty, None) let vspecMap = NameMap.map fst values values, vspecMap -let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = - +/// Make and publish the Val nodes for a collection of value specifications at Lambda and Match positions +/// +/// We merge the additions to the name resolution environment into one using a merged range so all values are brought +/// into scope simultaneously. The technique used to do this is a disturbing and unfortunate hack that +/// intercepts `NotifyNameResolution` calls being emitted by `MakeAndPublishSimpleVals` + +let MakeAndPublishSimpleValsForMergedScope cenv env m (names: NameMap<_>) = let values, vspecMap = - if not mergeNamesInOneNameresEnv then MakeSimpleVals cenv env names + if names.Count <= 1 then + MakeAndPublishSimpleVals cenv env names else - // reason: now during typecheck we create new name resolution environment for all components of tupled arguments in lambda. - // When trying to find best environment for the given position first we pick the most deeply nested scope that contains given position - // (and that will be lambda body - correct one), then we look for the better subtree on the left hand side - // (and that will be name resolution environment containing second parameter parameter - without the first one). - // fix: I've tried to make fix as local as possible to reduce overall impact on the source code. - // Idea of the fix: replace existing typecheck results sink and capture all reported name resolutions (this will be all parameters in lambda). - // After that - we restore the sink back, generate new name resolution environment that contains all captured names and report generated environment - // to the old sink. - - - // default behavior - send EnvWithScope notification for every resolved name - // what we do here is override this default behavior and capture only all name resolution notifications - // later we'll process them and create one name resolution env that will contain names from all notifications let nameResolutions = ResizeArray() let values, vspecMap = let sink = @@ -1875,14 +1869,14 @@ let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = member this.NotifyNameResolution(pos, item, itemGroup, itemTyparInst, occurence, denv, nenv, ad, m, replacing) = if not m.IsSynthetic then nameResolutions.Add(pos, item, itemGroup, itemTyparInst, occurence, denv, nenv, ad, m, replacing) - member this.NotifyExprHasType(_, _, _, _, _, _) = assert false // no expr typings in MakeSimpleVals + member this.NotifyExprHasType(_, _, _, _, _, _) = assert false // no expr typings in MakeAndPublishSimpleVals member this.NotifyFormatSpecifierLocation(_, _) = () member this.NotifyOpenDeclaration(_) = () member this.CurrentSourceText = None member this.FormatStringCheckContext = None } use _h = WithNewTypecheckResultsSink(sink, cenv.tcSink) - MakeSimpleVals cenv env names + MakeAndPublishSimpleVals cenv env names if nameResolutions.Count <> 0 then let (_, _, _, _, _, _, _, ad, m1, _replacing) = nameResolutions.[0] @@ -1905,8 +1899,6 @@ let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = let envinner = AddLocalValMap cenv.tcSink m vspecMap env envinner, values, vspecMap - - //------------------------------------------------------------------------- // Helpers to freshen existing types and values, i.e. when a reference // to C<_> occurs then generate C for a fresh type inference variable ?ty. @@ -3535,7 +3527,7 @@ let YieldFree cenv expr = | SynExpr.ForEach (_, _, _, _, _, body, _) -> YieldFree body - | SynExpr.LetOrUseBang(_, _, _, _, _, body, _) -> + | SynExpr.LetOrUseBang(_, _, _, _, _, _, body, _) -> YieldFree body | SynExpr.YieldOrReturn((true, _), _, _) -> false @@ -5775,7 +5767,7 @@ and TcExprs cenv env m tpenv flexes argTys args = and CheckSuperInit cenv objTy m = // Check the type is not abstract - match tryDestAppTy cenv.g objTy with + match tryTcrefOfAppTy cenv.g objTy with | ValueSome tcref when isAbstractTycon tcref.Deref -> errorR(Error(FSComp.SR.tcAbstractTypeCannotBeInstantiated(), m)) | _ -> () @@ -6249,7 +6241,7 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = error(Error(FSComp.SR.tcConstructRequiresSequenceOrComputations(), m)) | SynExpr.DoBang (_, m) - | SynExpr.LetOrUseBang (_, _, _, _, _, _, m) -> + | SynExpr.LetOrUseBang (range=m) -> error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) | SynExpr.MatchBang (_, _, _, m) -> @@ -6261,7 +6253,7 @@ and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = | SynExpr.Lambda (isMember, isSubsequent, spats, bodyExpr, m) when isMember || isFirst || isSubsequent -> let domainTy, resultTy = UnifyFunctionType None cenv env.DisplayEnv m overallTy let vs, (tpenv, names, takenNames) = TcSimplePats cenv isMember CheckCxs domainTy env (tpenv, Map.empty, takenNames) spats - let envinner, _, vspecMap = MakeAndPublishSimpleVals cenv env m names true + let envinner, _, vspecMap = MakeAndPublishSimpleValsForMergedScope cenv env m names let byrefs = vspecMap |> Map.map (fun _ v -> isByrefTy cenv.g v.Type, v) let envinner = if isMember then envinner else ExitFamilyRegion envinner let bodyExpr, tpenv = TcIteratedLambdas cenv false envinner resultTy takenNames tpenv bodyExpr @@ -6293,7 +6285,7 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg FoldPrimaryHierarchyOfType (fun ty acc -> match acc with | None -> - match tryDestAppTy cenv.g ty with + match tryTcrefOfAppTy cenv.g ty with | ValueSome tcref -> TryFindTyconRefStringAttribute cenv.g mWholeExpr cenv.g.attrib_DefaultMemberAttribute tcref | _ -> @@ -6860,7 +6852,7 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, let mObjTy = synObjTy.Range let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synObjTy - match tryDestAppTy cenv.g objTy with + match tryTcrefOfAppTy cenv.g objTy with | ValueNone -> error(Error(FSComp.SR.tcNewMustBeUsedWithNamedType(), mNewExpr)) | ValueSome tcref -> let isRecordTy = tcref.IsRecordTycon @@ -7529,6 +7521,9 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | [] -> callExpr | _ -> mkSynCall "Source" callExpr.Range [callExpr] + let mkSourceExprConditional isFromSource callExpr = + if isFromSource then mkSourceExpr callExpr else callExpr + /// Decide if the builder is an auto-quote builder let isAutoQuote = hasMethInfo "Quote" @@ -7979,7 +7974,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder if not q then error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere(), nm.idRange)) - let firstSource = if isFromSource then mkSourceExpr firstSource else firstSource + let firstSource = mkSourceExprConditional isFromSource firstSource let secondSource = mkSourceExpr secondSource // Add the variables to the variable space, on demand @@ -8123,11 +8118,12 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | SynExpr.ForEach (spForLoop, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp, _) -> - let wrappedSourceExpr = if isFromSource then mkSourceExpr sourceExpr else sourceExpr + let wrappedSourceExpr = mkSourceExprConditional isFromSource sourceExpr let mFor = match spForLoop with SequencePointAtForLoop m -> m | _ -> pat.Range let mPat = pat.Range let spBind = match spForLoop with SequencePointAtForLoop m -> SequencePointAtBinding m | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mFor ad "For" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("For"), mFor)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mFor ad "For" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("For"), mFor)) // Add the variables to the query variable space, on demand let varSpace = @@ -8149,16 +8145,20 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder let mGuard = guardExpr.Range let mWhile = match spWhile with SequencePointAtWhileLoop m -> m | _ -> mGuard if isQuery then error(Error(FSComp.SR.tcNoWhileInQuery(), mWhile)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "While" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("While"), mWhile)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mWhile)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "While" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("While"), mWhile)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mWhile ad "Delay" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mWhile)) Some(trans true q varSpace innerComp (fun holeFill -> translatedCtxt (mkSynCall "While" mWhile [mkSynDelay2 guardExpr; mkSynCall "Delay" mWhile [mkSynDelay innerComp.Range holeFill]])) ) | SynExpr.TryFinally (innerComp, unwindExpr, mTryToLast, spTry, _spFinally) -> let mTry = match spTry with SequencePointAtTry m -> m | _ -> mTryToLast if isQuery then error(Error(FSComp.SR.tcNoTryFinallyInQuery(), mTry)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryFinally" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryFinally"), mTry)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryFinally" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("TryFinally"), mTry)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) Some (translatedCtxt (mkSynCall "TryFinally" mTry [mkSynCall "Delay" mTry [mkSynDelay innerComp.Range (transNoQueryOps innerComp)]; mkSynDelay2 unwindExpr])) | SynExpr.Paren (_, _, _, m) -> @@ -8238,7 +8238,10 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | StripApps(SingleIdent nm, args) -> if args.Length = expectedArgCount then // Check for the [] attribute on each argument position - let args = args |> List.mapi (fun i arg -> if isCustomOperationProjectionParameter (i+1) nm then SynExpr.Lambda (false, false, varSpaceSimplePat, arg, arg.Range.MakeSynthetic()) else arg) + let args = args |> List.mapi (fun i arg -> + if isCustomOperationProjectionParameter (i+1) nm then + SynExpr.Lambda (false, false, varSpaceSimplePat, arg, arg.Range.MakeSynthetic()) + else arg) mkSynCall methInfo.DisplayName mClause (dataCompPrior :: args) else errorR(Error(FSComp.SR.tcCustomOperationHasIncorrectArgCount(nm.idText, expectedArgCount, args.Length), nm.idRange)) @@ -8266,7 +8269,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder // Rebind using either for ... or let!.... let rebind = if maintainsVarSpaceUsingBind then - SynExpr.LetOrUseBang (NoSequencePointAtLetBinding, false, false, intoPat, dataCompAfterOp, contExpr, intoPat.Range) + SynExpr.LetOrUseBang (NoSequencePointAtLetBinding, false, false, intoPat, dataCompAfterOp, [], contExpr, intoPat.Range) else SynExpr.ForEach (NoSequencePointAtForLoop, SeqExprOnly false, false, intoPat, dataCompAfterOp, contExpr, intoPat.Range) @@ -8288,7 +8291,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder // Rebind using either for ... or let!.... let rebind = if lastUsesBind then - SynExpr.LetOrUseBang (NoSequencePointAtLetBinding, false, false, varSpacePat, dataCompPrior, compClausesExpr, compClausesExpr.Range) + SynExpr.LetOrUseBang (NoSequencePointAtLetBinding, false, false, varSpacePat, dataCompPrior, [], compClausesExpr, compClausesExpr.Range) else SynExpr.ForEach (NoSequencePointAtForLoop, SeqExprOnly false, false, varSpacePat, dataCompPrior, compClausesExpr, compClausesExpr.Range) @@ -8316,8 +8319,10 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder // This is not pretty - we have to decide which range markers we use for the calls to Combine and Delay // NOTE: we should probably suppress these sequence points altogether let m1 = rangeForCombine innerComp1 - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Combine" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Combine"), m)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Combine" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Combine"), m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Delay" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), m)) Some (translatedCtxt (mkSynCall "Combine" m1 [c; mkSynCall "Delay" m1 [mkSynDelay innerComp2.Range (transNoQueryOps innerComp2)]])) | None -> // "do! expr; cexpr" is treated as { let! () = expr in cexpr } @@ -8328,7 +8333,8 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | SuppressSequencePointOnStmtOfSequential -> SequencePointAtBinding m | SuppressSequencePointOnExprOfSequential -> NoSequencePointAtDoBinding | SequencePointsAtSeq -> SequencePointAtBinding m - Some(trans true q varSpace (SynExpr.LetOrUseBang (sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, innerComp2, m)) translatedCtxt) + Some(trans true q varSpace (SynExpr.LetOrUseBang (sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, [], innerComp2, m)) translatedCtxt) + // "expr; cexpr" is treated as sequential execution | _ -> Some (trans true q varSpace innerComp2 (fun holeFill -> @@ -8353,7 +8359,8 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder Some (translatedCtxt (SynExpr.IfThenElse (guardExpr, transNoQueryOps thenComp, Some(transNoQueryOps elseComp), spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch))) | None -> let elseComp = - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mIfToThen ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"), mIfToThen)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mIfToThen ad "Zero" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"), mIfToThen)) mkSynCall "Zero" mIfToThen [] Some (trans true q varSpace thenComp (fun holeFill -> translatedCtxt (SynExpr.IfThenElse (guardExpr, holeFill, Some elseComp, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch)))) @@ -8385,7 +8392,6 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder // error case error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings(), mQueryOp))) - Some (trans true q varSpace innerComp (fun holeFill -> translatedCtxt (SynExpr.LetOrUse (isRec, false, binds, holeFill, m)))) // 'use x = expr in expr' @@ -8394,16 +8400,18 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder if isQuery then error(Error(FSComp.SR.tcUseMayNotBeUsedInQueries(), bindRange)) let innerCompRange = innerComp.Range let consumeExpr = SynExpr.MatchLambda(false, innerCompRange, [Clause(pat, None, transNoQueryOps innerComp, innerCompRange, SequencePointAtTarget)], spBind, innerCompRange) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Using" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) Some (translatedCtxt (mkSynCall "Using" bindRange [rhsExpr; consumeExpr ])) - // 'let! pat = expr in expr' --> build.Bind(e1, (function _argN -> match _argN with pat -> expr)) - | SynExpr.LetOrUseBang (spBind, false, isFromSource, pat, rhsExpr, innerComp, _) -> + // 'let! pat = expr in expr' + // --> build.Bind(e1, (fun _argN -> match _argN with pat -> expr)) + // or + // --> build.BindReturn(e1, (fun _argN -> match _argN with pat -> expr-without-return)) + | SynExpr.LetOrUseBang (spBind, false, isFromSource, pat, rhsExpr, [], innerComp, _) -> let bindRange = match spBind with SequencePointAtBinding m -> m | _ -> rhsExpr.Range if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), bindRange)) - let innerRange = innerComp.Range - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange)) // Add the variables to the query variable space, on demand let varSpace = @@ -8412,28 +8420,135 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (pat, None) vspecs, envinner) - let rhsExpr = if isFromSource then mkSourceExpr rhsExpr else rhsExpr - Some (trans true q varSpace innerComp (fun holeFill -> - let consumeExpr = SynExpr.MatchLambda (false, pat.Range, [Clause(pat, None, holeFill, innerRange, SequencePointAtTarget)], spBind, innerRange) - translatedCtxt (mkSynCall "Bind" bindRange [rhsExpr; consumeExpr]))) + let rhsExpr = mkSourceExprConditional isFromSource rhsExpr + Some (transBind q varSpace bindRange "Bind" [rhsExpr] pat spBind innerComp translatedCtxt) - // 'use! pat = e1 in e2' --> build.Bind(e1, (function _argN -> match _argN with pat -> build.Using(x, (fun _argN -> match _argN with pat -> e2)))) - | SynExpr.LetOrUseBang (spBind, true, isFromSource, (SynPat.Named (SynPat.Wild _, id, false, _, _) as pat), rhsExpr, innerComp, _) - | SynExpr.LetOrUseBang (spBind, true, isFromSource, (SynPat.LongIdent (LongIdentWithDots([id], _), _, _, _, _, _) as pat), rhsExpr, innerComp, _) -> + // 'use! pat = e1 in e2' --> build.Bind(e1, (function _argN -> match _argN with pat -> build.Using(x, (fun _argN -> match _argN with pat -> e2)))) + | SynExpr.LetOrUseBang (spBind, true, isFromSource, (SynPat.Named (SynPat.Wild _, id, false, _, _) as pat) , rhsExpr, [], innerComp, _) + | SynExpr.LetOrUseBang (spBind, true, isFromSource, (SynPat.LongIdent (longDotId=LongIdentWithDots([id], _)) as pat), rhsExpr, [], innerComp, _) -> let bindRange = match spBind with SequencePointAtBinding m -> m | _ -> rhsExpr.Range if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), bindRange)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange)) + + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Using" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad "Bind" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange)) + let consumeExpr = SynExpr.MatchLambda(false, bindRange, [Clause(pat, None, transNoQueryOps innerComp, innerComp.Range, SequencePointAtTarget)], spBind, bindRange) let consumeExpr = mkSynCall "Using" bindRange [SynExpr.Ident(id); consumeExpr ] let consumeExpr = SynExpr.MatchLambda(false, bindRange, [Clause(pat, None, consumeExpr, id.idRange, SequencePointAtTarget)], spBind, bindRange) - let rhsExpr = if isFromSource then mkSourceExpr rhsExpr else rhsExpr + let rhsExpr = mkSourceExprConditional isFromSource rhsExpr + // TODO: consider allowing translation to BindReturn Some(translatedCtxt (mkSynCall "Bind" bindRange [rhsExpr; consumeExpr])) - // 'use! pat = e1 in e2' where 'pat' is not a simple name --> error - | SynExpr.LetOrUseBang (_spBind, true, _isFromSource, pat, _rhsExpr, _innerComp, _) -> - error(Error(FSComp.SR.tcInvalidUseBangBinding(), pat.Range)) + // 'use! pat = e1 ... in e2' where 'pat' is not a simple name --> error + | SynExpr.LetOrUseBang (_spBind, true, _isFromSource, pat, _rhsExpr, andBangs, _innerComp, _) -> + if isNil andBangs then + error(Error(FSComp.SR.tcInvalidUseBangBinding(), pat.Range)) + else + error(Error(FSComp.SR.tcInvalidUseBangBindingNoAndBangs(), comp.Range)) + + // 'let! pat1 = expr1 and! pat2 = expr2 in ...' --> + // build.BindN(expr1, expr2, ...) + // or + // build.BindNReturn(expr1, expr2, ...) + // or + // build.Bind(build.MergeSources(expr1, expr2), ...) + | SynExpr.LetOrUseBang(letSpBind, false, isFromSource, letPat, letRhsExpr, andBangBindings, innerComp, letBindRange) -> + if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then + if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), letBindRange)) + let bindRange = match letSpBind with SequencePointAtBinding m -> m | _ -> letRhsExpr.Range + let sources = (letRhsExpr :: [for (_, _, _, _, andExpr, _) in andBangBindings -> andExpr ]) |> List.map (mkSourceExprConditional isFromSource) + let pats = letPat :: [for (_, _, _, andPat, _, _) in andBangBindings -> andPat ] + let sourcesRange = sources |> List.map (fun e -> e.Range) |> List.reduce unionRanges + + let numSources = sources.Length + let bindReturnNName = "Bind"+string numSources+"Return" + let bindNName = "Bind"+string numSources + + // Check if this is a Bind2Return etc. + let hasBindReturnN = not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindReturnNName builderTy)) + if hasBindReturnN && Option.isSome (convertSimpleReturnToExpr varSpace innerComp) then + let consumePat = SynPat.Tuple(false, pats, letPat.Range) + Some (transBind q varSpace bindRange bindNName sources consumePat letSpBind innerComp translatedCtxt) + + else + + // Check if this is a Bind2 etc. + let hasBindN = not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindNName builderTy)) + if hasBindN then + let consumePat = SynPat.Tuple(false, pats, letPat.Range) + + // Add the variables to the query variable space, on demand + let varSpace = + addVarsToVarSpace varSpace (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (consumePat, None) + vspecs, envinner) + + Some (transBind q varSpace bindRange bindNName sources consumePat letSpBind innerComp translatedCtxt) + else + + // Look for the maximum supported MergeSources, MergeSources3, ... + let mkMergeSourcesName n = if n = 2 then "MergeSources" else "MergeSources"+(string n) + + let maxMergeSources = + let rec loop (n: int) = + let mergeSourcesName = mkMergeSourcesName n + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad mergeSourcesName builderTy) then + (n-1) + else + loop (n+1) + loop 2 + + if maxMergeSources = 1 then error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange)) + + let rec mergeSources (sourcesAndPats: (SynExpr * SynPat) list) = + let numSourcesAndPats = sourcesAndPats.Length + assert (numSourcesAndPats <> 0) + if numSourcesAndPats = 1 then + sourcesAndPats.[0] + + elif numSourcesAndPats <= maxMergeSources then + + // Call MergeSources2(e1, e2), MergeSources3(e1, e2, e3) etc + let mergeSourcesName = mkMergeSourcesName numSourcesAndPats + + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad mergeSourcesName builderTy) then + error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange)) + + let source = mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) + let pat = SynPat.Tuple(false, List.map snd sourcesAndPats, letPat.Range) + source, pat + + else + + // Call MergeSourcesMax(e1, e2, e3, e4, (...)) + let nowSourcesAndPats, laterSourcesAndPats = List.splitAt (maxMergeSources - 1) sourcesAndPats + let mergeSourcesName = mkMergeSourcesName maxMergeSources + + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad mergeSourcesName builderTy) then + error(Error(FSComp.SR.tcRequireMergeSourcesOrBindN(bindNName), bindRange)) + + let laterSource, laterPat = mergeSources laterSourcesAndPats + let source = mkSynCall mergeSourcesName sourcesRange (List.map fst nowSourcesAndPats @ [laterSource]) + let pat = SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [laterPat], letPat.Range) + source, pat + + let mergedSources, consumePat = mergeSources (List.zip sources pats) + + // Add the variables to the query variable space, on demand + let varSpace = + addVarsToVarSpace varSpace (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (consumePat, None) + vspecs, envinner) + + // Build the 'Bind' call + Some (transBind q varSpace bindRange "Bind" [mergedSources] consumePat letSpBind innerComp translatedCtxt) + else + error(Error(FSComp.SR.tcAndBangNotSupported(), comp.Range)) | SynExpr.Match (spMatch, expr, clauses, m) -> let mMatch = match spMatch with SequencePointAtBinding mMatch -> mMatch | _ -> m @@ -8445,9 +8560,14 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | SynExpr.MatchBang (spMatch, expr, clauses, m) -> let mMatch = match spMatch with SequencePointAtBinding mMatch -> mMatch | _ -> m if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(), mMatch)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mMatch ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), mMatch)) + + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mMatch ad "Bind" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), mMatch)) + let clauses = clauses |> List.map (fun (Clause(pat, cond, innerComp, patm, sp)) -> Clause(pat, cond, transNoQueryOps innerComp, patm, sp)) let consumeExpr = SynExpr.MatchLambda (false, mMatch, clauses, spMatch, mMatch) + + // TODO: consider allowing translation to BindReturn Some(translatedCtxt (mkSynCall "Bind" mMatch [expr; consumeExpr])) | SynExpr.TryWith (innerComp, _mTryToWith, clauses, _mWithToLast, mTryToLast, spTry, _spWith) -> @@ -8456,14 +8576,19 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder if isQuery then error(Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries(), mTry)) let clauses = clauses |> List.map (fun (Clause(pat, cond, clauseComp, patm, sp)) -> Clause(pat, cond, transNoQueryOps clauseComp, patm, sp)) let consumeExpr = SynExpr.MatchLambda(true, mTryToLast, clauses, NoSequencePointAtStickyBinding, mTryToLast) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryWith" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryWith"), mTry)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) + + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "TryWith" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("TryWith"), mTry)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mTry ad "Delay" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) + Some(translatedCtxt (mkSynCall "TryWith" mTry [mkSynCall "Delay" mTry [mkSynDelay2 (transNoQueryOps innerComp)]; consumeExpr])) | SynExpr.YieldOrReturnFrom ((isYield, _), yieldExpr, m) -> let yieldExpr = mkSourceExpr yieldExpr if isYield then - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "YieldFrom" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("YieldFrom"), m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "YieldFrom" builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod("YieldFrom"), m)) Some (translatedCtxt (mkSynCall "YieldFrom" m [yieldExpr])) else @@ -8477,7 +8602,8 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder | SynExpr.YieldOrReturn ((isYield, _), yieldExpr, m) -> let methName = (if isYield then "Yield" else "Return") if isQuery && not isYield then error(Error(FSComp.SR.tcReturnMayNotBeUsedInQueries(), m)) - if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad methName builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod(methName), m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad methName builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod(methName), m)) Some(translatedCtxt (mkSynCall methName m [yieldExpr])) | _ -> None @@ -8500,8 +8626,8 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Return" builderTy) then SynExpr.ImplicitZero m else - SynExpr.YieldOrReturn((false, true), SynExpr.Const (SynConst.Unit, m), m) - trans true q varSpace (SynExpr.LetOrUseBang(NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, bodyExpr, m)) translatedCtxt + SynExpr.YieldOrReturn((false, true), SynExpr.Const(SynConst.Unit, m), m) + trans true q varSpace (SynExpr.LetOrUseBang (NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, [], bodyExpr, m)) translatedCtxt // "expr;" in final position is treated as { expr; zero } // Suppress the sequence point on the "zero" @@ -8523,6 +8649,104 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder SynExpr.Sequential(SuppressSequencePointOnStmtOfSequential, true, comp, holeFill, comp.Range) translatedCtxt fillExpr) + and transBind q varSpace bindRange bindName bindArgs (consumePat: SynPat) spBind (innerComp: SynExpr) translatedCtxt = + + let innerRange = innerComp.Range + + let innerCompReturn = + if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then + convertSimpleReturnToExpr varSpace innerComp + else None + + match innerCompReturn with + | Some innerExpr when + (let bindName = bindName + "Return" + not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy))) -> + + let bindName = bindName + "Return" + + // Build the `BindReturn` call + let consumeExpr = SynExpr.MatchLambda(false, consumePat.Range, [Clause(consumePat, None, innerExpr, innerRange, SequencePointAtTarget)], spBind, innerRange) + translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [consumeExpr])) + + | _ -> + + if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy) then + error(Error(FSComp.SR.tcRequireBuilderMethod(bindName), bindRange)) + + // Build the `Bind` call + trans true q varSpace innerComp (fun holeFill -> + let consumeExpr = SynExpr.MatchLambda(false, consumePat.Range, [Clause(consumePat, None, holeFill, innerRange, SequencePointAtTarget)], spBind, innerRange) + translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [consumeExpr]))) + + and convertSimpleReturnToExpr varSpace innerComp = + match innerComp with + | SynExpr.YieldOrReturn ((false, _), returnExpr, _) -> Some returnExpr + | SynExpr.Match (spMatch, expr, clauses, m) -> + let clauses = + clauses |> List.map (fun (Clause(pat, cond, innerComp2, patm, sp)) -> + match convertSimpleReturnToExpr varSpace innerComp2 with + | None -> None + | Some innerExpr2 -> Some (Clause(pat, cond, innerExpr2, patm, sp))) + if clauses |> List.forall Option.isSome then + Some (SynExpr.Match (spMatch, expr, (clauses |> List.map Option.get), m)) + else + None + + | SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch) -> + match convertSimpleReturnToExpr varSpace thenComp with + | None -> None + | Some thenExpr -> + match Option.map (convertSimpleReturnToExpr varSpace) elseCompOpt with + | Some None -> None + | elseExprOpt -> + Some (SynExpr.IfThenElse (guardExpr, thenExpr, Option.bind id elseExprOpt, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch) ) + + | SynExpr.LetOrUse (isRec, false, binds, innerComp, m) -> + match convertSimpleReturnToExpr varSpace innerComp with + | None -> None + | Some innerExpr -> Some (SynExpr.LetOrUse (isRec, false, binds, innerExpr, m)) + + | SynExpr.Sequential (sp, true, innerComp1, innerComp2, m) -> + + // Check the first part isn't a computation expression construct + if isSimpleExpr innerComp1 then + // Check the second part is a simple return + match convertSimpleReturnToExpr varSpace innerComp2 with + | None -> None + | Some innerExpr2 -> Some (SynExpr.Sequential (sp, true, innerComp1, innerExpr2, m)) + else + None + + | _ -> None + + /// Check is an expression has no computation expression constructs + and isSimpleExpr comp = + + match comp with + | ForEachThenJoinOrGroupJoinOrZipClause _ -> false + | SynExpr.ForEach _ -> false + | SynExpr.For _ -> false + | SynExpr.While _ -> false + | SynExpr.TryFinally _ -> false + | SynExpr.ImplicitZero _ -> false + | OptionalSequential (JoinOrGroupJoinOrZipClause _, _) -> false + | OptionalSequential (CustomOperationClause _, _) -> false + | SynExpr.Sequential (_, _, innerComp1, innerComp2, _) -> isSimpleExpr innerComp1 && isSimpleExpr innerComp2 + | SynExpr.IfThenElse (_, thenComp, elseCompOpt, _, _, _, _) -> + isSimpleExpr thenComp && (match elseCompOpt with None -> true | Some c -> isSimpleExpr c) + | SynExpr.LetOrUse (_, _, _, innerComp, _) -> isSimpleExpr innerComp + | SynExpr.LetOrUseBang _ -> false + | SynExpr.Match (_, _, clauses, _) -> + clauses |> List.forall (fun (Clause(_, _, innerComp, _, _)) -> isSimpleExpr innerComp) + | SynExpr.MatchBang _ -> false + | SynExpr.TryWith (innerComp, _, clauses, _, _, _, _) -> + isSimpleExpr innerComp && + clauses |> List.forall (fun (Clause(_, _, clauseComp, _, _)) -> isSimpleExpr clauseComp) + | SynExpr.YieldOrReturnFrom _ -> false + | SynExpr.YieldOrReturn _ -> false + | _ -> true + let basicSynExpr = trans true (hasCustomOperations ()) (LazyWithContext.NotLazy ([], env)) comp (fun holeFill -> holeFill) @@ -8546,7 +8770,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder SynExpr.Lambda (false, false, SynSimplePats.SimplePats ([mkSynSimplePatVar false (mkSynId mBuilderVal builderValName)], mBuilderVal), runExpr, mBuilderVal) let env = - match comp with + match comp with | SynExpr.YieldOrReturn ((true, _), _, _) -> { env with eContextInfo = ContextInfo.YieldInComputationExpression } | SynExpr.YieldOrReturn ((_, true), _, _) -> { env with eContextInfo = ContextInfo.ReturnInComputationExpression } | _ -> env @@ -8693,7 +8917,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = //SEQPOINT NEEDED - we must consume spBind on this path Some(mkSeqUsing cenv env wholeExprMark bindPatTy genOuterTy inputExpr consumeExpr, tpenv) - | SynExpr.LetOrUseBang (_, _, _, _, _, _, m) -> + | SynExpr.LetOrUseBang (range=m) -> error(Error(FSComp.SR.tcUseForInSequenceExpression(), m)) | SynExpr.Match (spMatch, expr, clauses, _) -> @@ -8711,7 +8935,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = let matchv, matchExpr = CompilePatternForMatchClauses cenv env inputExprMark inputExprMark true ThrowIncompleteMatchException (Some inputExpr) inputExprTy genOuterTy tclauses Some(mkLet spMatch inputExprMark matchv inputExpr matchExpr, tpenv) - | SynExpr.TryWith (_, mTryToWith, _, _, _, _, _) -> + | SynExpr.TryWith (tryRange=mTryToWith) -> error(Error(FSComp.SR.tcTryIllegalInSequenceExpression(), mTryToWith)) | SynExpr.YieldOrReturnFrom ((isYield, _), yieldExpr, m) -> @@ -10587,7 +10811,7 @@ and TcAndPatternCompileMatchClauses mExpr matchm actionOnFailure cenv inputExprO and TcMatchPattern cenv inputTy env tpenv (pat: SynPat, optWhenExpr) = let m = pat.Range let patf', (tpenv, names, _) = TcPat WarnOnUpperCase cenv env None (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, false) (tpenv, Map.empty, Set.empty) inputTy pat - let envinner, values, vspecMap = MakeAndPublishSimpleVals cenv env m names false + let envinner, values, vspecMap = MakeAndPublishSimpleValsForMergedScope cenv env m names let optWhenExpr', tpenv = match optWhenExpr with | Some whenExpr -> @@ -12670,7 +12894,7 @@ module IncrClassChecking = let ctorArgNames, (_, names, _) = TcSimplePatsOfUnknownType cenv true CheckCxs env tpenv (SynSimplePats.SimplePats (spats, m)) // Create the values with the given names - let _, vspecs = MakeSimpleVals cenv env names + let _, vspecs = MakeAndPublishSimpleVals cenv env names if tcref.IsStructOrEnumTycon && isNil spats then errorR (ParameterlessStructCtor(tcref.Range)) @@ -14385,7 +14609,7 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: module AddAugmentationDeclarations = let tcaugHasNominalInterface g (tcaug: TyconAugmentation) tcref = tcaug.tcaug_interfaces |> List.exists (fun (x, _, _) -> - match tryDestAppTy g x with + match tryTcrefOfAppTy g x with | ValueSome tcref2 when tyconRefEq g tcref2 tcref -> true | _ -> false) @@ -16062,7 +16286,7 @@ module EstablishTypeDefinitionCores = (tycon, tycon2) :: acc else acc // note: all edges added are (tycon, _) let insertEdgeToType ty acc = - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> insertEdgeToTycon tcref.Deref acc | _ -> diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index 524f73965e..40e90b679a 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -764,12 +764,13 @@ and /// Computation expressions only | YieldOrReturnFrom of (bool * bool) * expr: SynExpr * range: range - /// SynExpr.LetOrUseBang (spBind, isUse, isFromSource, pat, rhsExpr, bodyExpr, mWholeExpr). + /// SynExpr.LetOrUseAndBang (spBind, isUse, isFromSource, pat, rhsExpr, mLetBangExpr, [(andBangSpBind, andBangIsUse, andBangIsFromSource, andBangPat, andBangRhsExpr, mAndBangExpr)], bodyExpr). /// /// F# syntax: let! pat = expr in expr /// F# syntax: use! pat = expr in expr + /// F# syntax: let! pat = expr and! ... and! ... and! pat = expr in expr /// Computation expressions only - | LetOrUseBang of bindSeqPoint: SequencePointInfoForBinding * isUse: bool * isFromSource: bool * SynPat * SynExpr * SynExpr * range: range + | LetOrUseBang of bindSeqPoint: SequencePointInfoForBinding * isUse: bool * isFromSource: bool * SynPat * rhs: SynExpr * andBangs:(SequencePointInfoForBinding * bool * bool * SynPat * SynExpr * range) list * body:SynExpr * range: range /// F# syntax: match! expr with pat1 -> expr | ... | patN -> exprN | MatchBang of matchSeqPoint: SequencePointInfoForBinding * expr: SynExpr * clauses: SynMatchClause list * range: range (* bool indicates if this is an exception match in a computation expression which throws unmatched exceptions *) @@ -2475,6 +2476,6 @@ let rec synExprContainsError inpExpr = | SynExpr.MatchBang (_, e, cl, _) -> walkExpr e || walkMatchClauses cl - | SynExpr.LetOrUseBang (_, _, _, _, e1, e2, _) -> - walkExpr e1 || walkExpr e2 + | SynExpr.LetOrUseBang (rhs=e1;body=e2;andBangs=es) -> + walkExpr e1 || walkExprs [ for (_,_,_,_,e,_) in es do yield e ] || walkExpr e2 walkExpr inpExpr diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index a12fd76dd3..f64c5357ca 100755 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -29,8 +29,9 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader -open FSharp.Compiler.AbstractIL.Internal +open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.IlxGen diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 9f6df3f16a..cf634a6103 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -29,6 +29,7 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.AbstractIL.ILRuntimeWriter open FSharp.Compiler.Lib open FSharp.Compiler.AccessibilityLogic @@ -956,10 +957,9 @@ type internal FsiDynamicCompiler let outfile = "TMPFSCI.exe" let assemblyName = "FSI-ASSEMBLY" - let assemblyReferenceAddedEvent = Control.Event() let valueBoundEvent = Control.Event<_>() let dependencyAddingEvent = Control.Event() - let dependencyAddedEvent = Control.Event() + let dependencyAddedEvent = Control.Event() let dependencyFailedEvent = Control.Event() let mutable fragmentId = 0 @@ -1260,7 +1260,7 @@ type internal FsiDynamicCompiler let tcState = istate.tcState let tcEnv,(_dllinfos,ccuinfos) = try - RequireDLL (ctok, tcImports, tcState.TcEnvFromImpls, assemblyName, m, path, assemblyReferenceAddedEvent.Trigger) + RequireDLL (ctok, tcImports, tcState.TcEnvFromImpls, assemblyName, m, path) with e -> tcConfigB.RemoveReferencedAssemblyByPath(m,path) reraise() @@ -1303,7 +1303,7 @@ type internal FsiDynamicCompiler Event.add dependencyAddingEvent.Trigger packageManager.DependencyAdding Event.add dependencyAddedEvent.Trigger packageManager.DependencyAdded Event.add dependencyFailedEvent.Trigger packageManager.DependencyFailed - match DependencyManagerIntegration.resolve packageManager tcConfigB.implicitIncludeDir "stdin.fsx" "stdin.fsx" m packageManagerTextLines with + match DependencyManagerIntegration.resolve packageManager ".fsx" m packageManagerTextLines with | None -> istate // error already reported | Some (succeeded, generatedScripts, additionalIncludeFolders) -> //@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ if succeeded then @@ -1402,8 +1402,6 @@ type internal FsiDynamicCompiler member __.FormatValue(obj:obj, objTy) = valuePrinter.FormatValue(obj, objTy) - member __.AssemblyReferenceAdded = assemblyReferenceAddedEvent.Publish - member __.ValueBound = valueBoundEvent.Publish member __.DependencyAdding = dependencyAddingEvent.Publish @@ -1909,8 +1907,6 @@ type internal FsiInteractionProcessor let referencedAssemblies = Dictionary() - let assemblyReferencedEvent = Control.Event() - let mutable currState = initialInteractiveState let event = Control.Event() let setCurrState s = currState <- s; event.Trigger() @@ -2451,8 +2447,6 @@ type internal FsiInteractionProcessor let fsiInteractiveChecker = FsiInteractiveChecker(legacyReferenceResolver, checker, tcConfig, istate.tcGlobals, istate.tcImports, istate.tcState) fsiInteractiveChecker.ParseAndCheckInteraction(ctok, SourceText.ofString text) - member __.AssemblyReferenceAdded = assemblyReferencedEvent.Publish - //---------------------------------------------------------------------------- // Server mode: @@ -2547,8 +2541,6 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | None -> SimulatedMSBuildReferenceResolver.getResolver() | Some rr -> rr - let includePathAddedEvent = Control.Event<_>() - let tcConfigB = TcConfigBuilder.CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir=defaultFSharpBinariesDir, @@ -2557,8 +2549,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i isInteractive=true, isInvalidationSupported=false, defaultCopyFSharpCore=CopyFSharpCoreFlag.No, - tryGetMetadataSnapshot=tryGetMetadataSnapshot, - includePathAdded=includePathAddedEvent.Trigger) + tryGetMetadataSnapshot=tryGetMetadataSnapshot) let tcConfigP = TcConfigProvider.BasedOnMutableBuilder(tcConfigB) do tcConfigB.resolutionEnvironment <- ResolutionEnvironment.CompilationAndEvaluation // See Bug 3608 @@ -2862,17 +2853,9 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i |> commitResultNonThrowing errorOptions scriptPath errorLogger |> function Choice1Of2 (_), errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs - [] - /// Event fires every time an assembly reference is added to the execution environment, e.g., via `#r`. - member __.AssemblyReferenceAdded = fsiDynamicCompiler.AssemblyReferenceAdded - /// Event fires when a root-level value is bound to an identifier, e.g., via `let x = ...`. member __.ValueBound = fsiDynamicCompiler.ValueBound - [] - /// Event fires every time a path is added to the include search list, e.g., via `#I`. - member __.IncludePathAdded = includePathAddedEvent.Publish - [] /// Event fires at the start of adding a dependency via the dependency manager. member __.DependencyAdding = fsiDynamicCompiler.DependencyAdding diff --git a/src/fsharp/fsi/fsi.fsi b/src/fsharp/fsi/fsi.fsi index d9bf96f123..d8f66297e7 100644 --- a/src/fsharp/fsi/fsi.fsi +++ b/src/fsharp/fsi/fsi.fsi @@ -234,21 +234,13 @@ type FsiEvaluationSession = /// A host calls this to report an unhandled exception in a standard way, e.g. an exception on the GUI thread gets printed to stderr member ReportUnhandledException : exn: exn -> unit - [] - /// Event fires every time an assembly reference is added to the execution environment, e.g., via `#r`. - member AssemblyReferenceAdded: IEvent - - [] - /// Event fires every time a path is added to the include search list, e.g., via `#I`. - member IncludePathAdded: IEvent - [] /// Event fires at the start of adding a dependency via the dependency manager. member DependencyAdding: IEvent [] /// Event fires at the successful completion of adding a dependency via the dependency manager. - member DependencyAdded: IEvent + member DependencyAdded: IEvent [] /// Event fires at the failure to adding a dependency via the dependency manager. diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl index 901a203b83..5970e1fb8c 100755 --- a/src/fsharp/lex.fsl +++ b/src/fsharp/lex.fsl @@ -233,10 +233,12 @@ rule token args skip = parse { YIELD_BANG(false) } | "match!" { MATCH_BANG } + | "and!" + { AND_BANG(false) } | ident '!' { let tok = Keywords.KeywordOrIdentifierToken args lexbuf (lexemeTrimRight lexbuf 1) match tok with - | LET _ -> BINDER (lexemeTrimRight lexbuf 1) + | LET _ -> BINDER (lexemeTrimRight lexbuf 1) | _ -> fail args lexbuf (FSComp.SR.lexIdentEndInMarkReserved("!")) (Keywords.KeywordOrIdentifierToken args lexbuf (lexeme lexbuf)) } | ident ('#') { fail args lexbuf (FSComp.SR.lexIdentEndInMarkReserved("#")) (Keywords.KeywordOrIdentifierToken args lexbuf (lexeme lexbuf)) } diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index e1d888196b..66ee0bd792 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -189,7 +189,7 @@ let rangeOfLongIdent(lid:LongIdent) = %token CHAR %token DECIMAL %token <(string * string)> BIGNUM -%token LET YIELD YIELD_BANG +%token LET YIELD YIELD_BANG AND_BANG %token LESS GREATER /* here the bool indicates if the tokens are part of a type application or type parameter declaration, e.g. C, detected by the lex filter */ %token PERCENT_OP BINDER %token LQUOTE RQUOTE RQUOTE_DOT @@ -218,6 +218,7 @@ let rangeOfLongIdent(lid:LongIdent) = /* for offside rule */ %token OLET /* LexFilter #light converts 'LET' tokens to 'OLET' when starting (CtxtLetDecl(blockLet=true)) */ %token OBINDER /* LexFilter #light converts 'BINDER' tokens to 'OBINDER' when starting (CtxtLetDecl(blockLet=true)) */ +%token OAND_BANG /* LexFilter #light converts 'AND_BANG' tokens to 'OAND_BANG' when starting (CtxtLetDecl(blockLet=true)) */ %token ODO /* LexFilter #light converts 'DO' tokens to 'ODO' */ %token ODO_BANG /* LexFilter #light converts 'DO_BANG' tokens to 'ODO_BANG' */ %token OTHEN /* LexFilter #light converts 'THEN' tokens to 'OTHEN' */ @@ -453,7 +454,8 @@ let rangeOfLongIdent(lid:LongIdent) = %nonassoc paren_pat_colon %nonassoc paren_pat_attribs %left OR BAR_BAR JOIN_IN -%left AND /* check */ +%left AND +%left AND_BANG %left AMP AMP_AMP %nonassoc pat_conj %nonassoc expr_not @@ -3060,6 +3062,20 @@ recover: | error { debugPrint("recovering via error"); true } | EOF { debugPrint("recovering via EOF"); false } +morebinders: + | AND_BANG headBindingPattern EQUALS typedSeqExprBlock IN morebinders %prec expr_let + { let spBind = SequencePointAtBinding(rhs2 parseState 1 5) (* TODO Pretty sure this is wrong *) + let m = rhs parseState 1 (* TODO Pretty sure this is wrong *) + (spBind,$1,true,$2,$4,m) :: $6 } + + | OAND_BANG headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP morebinders %prec expr_let + { $5 "and!" (rhs parseState 1) // report unterminated error + let spBind = SequencePointAtBinding(rhs2 parseState 1 5) (* TODO Pretty sure this is wrong *) + let m = rhs parseState 1 (* TODO Pretty sure this is wrong *) + (spBind,$1,true,$2,$4,m) :: $7 } + + | %prec prec_no_more_attr_bindings + { [] } declExpr: | defnBindings IN typedSeqExpr %prec expr_let @@ -3353,27 +3369,35 @@ declExpr: | YIELD_BANG declExpr { SynExpr.YieldOrReturnFrom (($1,not $1), $2, unionRanges (rhs parseState 1) $2.Range) } - | BINDER headBindingPattern EQUALS typedSeqExprBlock IN opt_OBLOCKSEP typedSeqExprBlock %prec expr_let + | YIELD recover + { let mYieldAll = rhs parseState 1 + SynExpr.YieldOrReturn (($1, not $1), arbExpr("yield", mYieldAll), mYieldAll) } + + | YIELD_BANG recover + { let mYieldAll = rhs parseState 1 + SynExpr.YieldOrReturnFrom (($1, not $1), arbExpr("yield!", mYieldAll), mYieldAll) } + + | BINDER headBindingPattern EQUALS typedSeqExprBlock IN opt_OBLOCKSEP morebinders typedSeqExprBlock %prec expr_let { let spBind = SequencePointAtBinding(rhs2 parseState 1 5) - let m = unionRanges (rhs parseState 1) $7.Range - SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4,$7,m) } + let m = unionRanges (rhs parseState 1) $8.Range + SynExpr.LetOrUseBang(spBind, ($1 = "use"), true, $2, $4, $7, $8, m) } - | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP typedSeqExprBlock %prec expr_let + | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP morebinders typedSeqExprBlock %prec expr_let { $5 (if $1 = "use" then "use!" else "let!") (rhs parseState 1) // report unterminated error let spBind = SequencePointAtBinding(unionRanges (rhs parseState 1) $4.Range) - let m = unionRanges (rhs parseState 1) $7.Range - SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4,$7,m) } + let m = unionRanges (rhs parseState 1) $8.Range + SynExpr.LetOrUseBang(spBind, ($1 = "use"), true, $2, $4, $7, $8, m) } | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP error %prec expr_let { // error recovery that allows intellisense when writing incomplete computation expressions let spBind = SequencePointAtBinding(unionRanges (rhs parseState 1) $4.Range) let mAll = unionRanges (rhs parseState 1) (rhs parseState 7) let m = $4.Range.EndRange // zero-width range - SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4, SynExpr.ImplicitZero m, mAll) } + SynExpr.LetOrUseBang(spBind, ($1 = "use"), true, $2, $4, [], SynExpr.ImplicitZero m, mAll) } | DO_BANG typedSeqExpr IN opt_OBLOCKSEP typedSeqExprBlock %prec expr_let { let spBind = NoSequencePointAtDoBinding - SynExpr.LetOrUseBang (spBind,false,true,SynPat.Const(SynConst.Unit,$2.Range),$2,$5, unionRanges (rhs parseState 1) $5.Range) } + SynExpr.LetOrUseBang(spBind, false, true, SynPat.Const(SynConst.Unit,$2.Range), $2, [], $5, unionRanges (rhs parseState 1) $5.Range) } | ODO_BANG typedSeqExprBlock hardwhiteDefnBindingsTerminator %prec expr_let { SynExpr.DoBang ($2, unionRanges (rhs parseState 1) $2.Range) } diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 76585ba9d5..13517c0375 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -622,7 +622,7 @@ type internal TypeCheckInfo let getType() = match NameResolution.TryToResolveLongIdentAsType ncenv nenv m plid with - | Some x -> tryDestAppTy g x + | Some x -> tryTcrefOfAppTy g x | None -> match lastDotPos |> Option.orElseWith (fun _ -> FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1)) with | Some p when lineStr.[p] = '.' -> @@ -630,7 +630,7 @@ type internal TypeCheckInfo | Some colAtEndOfNames -> let colAtEndOfNames = colAtEndOfNames + 1 // convert 0-based to 1-based match TryGetTypeFromNameResolution(line, colAtEndOfNames, residueOpt, resolveOverloads) with - | Some x -> tryDestAppTy g x + | Some x -> tryTcrefOfAppTy g x | _ -> ValueNone | None -> ValueNone | _ -> ValueNone @@ -675,7 +675,7 @@ type internal TypeCheckInfo // it appears we're getting some typings recorded for non-atomic expressions like "f x" when isNil plid -> // lookup based on expression typings successful - Some (items |> List.map (CompletionItem (tryDestAppTy g ty) ValueNone), denv, m) + Some (items |> List.map (CompletionItem (tryTcrefOfAppTy g ty) ValueNone), denv, m) | GetPreciseCompletionListFromExprTypingsResult.NoneBecauseThereWereTypeErrors, _ -> // There was an error, e.g. we have "." and there is an error determining the type of // In this case, we don't want any of the fallback logic, rather, we want to produce zero results. @@ -708,7 +708,7 @@ type internal TypeCheckInfo // Try again with the qualItems | _, _, GetPreciseCompletionListFromExprTypingsResult.Some(FilterRelevantItems getItem exactMatchResidueOpt (items, denv, m), ty) -> - ValueSome(items |> List.map (CompletionItem (tryDestAppTy g ty) ValueNone), denv, m) + ValueSome(items |> List.map (CompletionItem (tryTcrefOfAppTy g ty) ValueNone), denv, m) | _ -> ValueNone diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs index e495fa0428..b826728b47 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fs +++ b/src/fsharp/service/ServiceAssemblyContent.fs @@ -703,9 +703,13 @@ module ParsedInput = addLongIdentWithDots ident List.iter walkExpr [e1; e2; e3] | SynExpr.JoinIn (e1, _, e2, _) -> List.iter walkExpr [e1; e2] - | SynExpr.LetOrUseBang (_, _, _, pat, e1, e2, _) -> + | SynExpr.LetOrUseBang (_, _, _, pat, e1, es, e2, _) -> walkPat pat - List.iter walkExpr [e1; e2] + walkExpr e1 + for (_,_,_,patAndBang,eAndBang,_) in es do + walkPat patAndBang + walkExpr eAndBang + walkExpr e2 | SynExpr.TraitCall (ts, sign, e, _) -> List.iter walkTypar ts walkMemberSig sign diff --git a/src/fsharp/service/ServiceDeclarationLists.fs b/src/fsharp/service/ServiceDeclarationLists.fs index ef9c0b4098..9f106520d0 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fs +++ b/src/fsharp/service/ServiceDeclarationLists.fs @@ -384,7 +384,7 @@ module internal DescriptionListsImpl = /// Find the glyph for the given type representation. let typeToGlyph ty = - match tryDestAppTy denv.g ty with + match tryTcrefOfAppTy denv.g ty with | ValueSome tcref -> tcref.TypeReprInfo |> reprToGlyph | _ -> if isStructTupleTy denv.g ty then FSharpGlyph.Struct diff --git a/src/fsharp/service/ServiceInterfaceStubGenerator.fs b/src/fsharp/service/ServiceInterfaceStubGenerator.fs index dfaa9a537a..e5461138bf 100644 --- a/src/fsharp/service/ServiceInterfaceStubGenerator.fs +++ b/src/fsharp/service/ServiceInterfaceStubGenerator.fs @@ -896,8 +896,14 @@ module InterfaceStubGenerator = | SynExpr.DoBang (synExpr, _range) -> walkExpr synExpr - | SynExpr.LetOrUseBang (_sequencePointInfoForBinding, _, _, _synPat, synExpr1, synExpr2, _range) -> - List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.LetOrUseBang (_sequencePointInfoForBinding, _, _, _synPat, synExpr1, synExprAndBangs, synExpr2, _range) -> + [ + yield synExpr1 + for (_,_,_,_,eAndBang,_) in synExprAndBangs do + yield eAndBang + yield synExpr2 + ] + |> List.tryPick walkExpr | SynExpr.LibraryOnlyILAssembly _ | SynExpr.LibraryOnlyStaticOptimization _ diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs old mode 100644 new mode 100755 index 4a5147bbb6..c7cddd48b1 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -261,14 +261,14 @@ module internal TokenClassifications = | MEMBER | STATIC | NAMESPACE | OASSERT | OLAZY | ODECLEND | OBLOCKSEP | OEND | OBLOCKBEGIN | ORIGHT_BLOCK_END | OBLOCKEND | OBLOCKEND_COMING_SOON | OBLOCKEND_IS_HERE | OTHEN | OELSE | OLET(_) - | OBINDER _ | BINDER _ | ODO | OWITH | OFUNCTION | OFUN | ORESET | ODUMMY _ | DO_BANG + | OBINDER _ | OAND_BANG _ | BINDER _ | ODO | OWITH | OFUNCTION | OFUN | ORESET | ODUMMY _ | DO_BANG | ODO_BANG | YIELD _ | YIELD_BANG _ | OINTERFACE_MEMBER | ELIF | RARROW | LARROW | SIG | STRUCT | UPCAST | DOWNCAST | NULL | RESERVED | MODULE | AND | AS | ASSERT | ASR | DOWNTO | EXCEPTION | FALSE | FOR | FUN | FUNCTION | FINALLY | LAZY | MATCH | MATCH_BANG | MUTABLE | NEW | OF | OPEN | OR | VOID | EXTERN | INTERFACE | REC | TO | TRUE | TRY | TYPE | VAL | INLINE | WHEN | WHILE | WITH - | IF | THEN | ELSE | DO | DONE | LET(_) | IN (*| NAMESPACE*) | CONST + | IF | THEN | ELSE | DO | DONE | LET _ | AND_BANG _ | IN | CONST | HIGH_PRECEDENCE_PAREN_APP | FIXED | HIGH_PRECEDENCE_BRACK_APP | TYPE_COMING_SOON | TYPE_IS_HERE | MODULE_COMING_SOON | MODULE_IS_HERE -> diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index eeab436524..a1c42f7fa7 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -473,10 +473,16 @@ module public AstTraversal = | SynExpr.ImplicitZero (_range) -> None | SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.LetOrUseBang (_sequencePointInfoForBinding, _, _, synPat, synExpr, synExpr2, _range) -> - [dive synPat synPat.Range traversePat - dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr] + | SynExpr.LetOrUseBang(_sequencePointInfoForBinding, _, _, synPat, synExpr, andBangSynExprs, synExpr2, _range) -> + [ + yield dive synPat synPat.Range traversePat + yield dive synExpr synExpr.Range traverseSynExpr + yield! + [ for (_,_,_,andBangSynPat,andBangSynExpr,_) in andBangSynExprs do + yield (dive andBangSynPat andBangSynPat.Range traversePat) + yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr)] + yield dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr | SynExpr.MatchBang (_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) -> [yield dive synExpr synExpr.Range traverseSynExpr diff --git a/src/fsharp/service/ServiceStructure.fs b/src/fsharp/service/ServiceStructure.fs index 56f2312da4..8df0fedbb8 100644 --- a/src/fsharp/service/ServiceStructure.fs +++ b/src/fsharp/service/ServiceStructure.fs @@ -245,14 +245,21 @@ module Structure = | SynExpr.DoBang (e, r) -> rcheck Scope.Do Collapse.Below r <| Range.modStart 3 r parseExpr e - | SynExpr.LetOrUseBang (_, _, _, pat, e1, e2, _) -> - // for `let!` or `use!` the pattern begins at the end of the keyword so that - // this scope can be used without adjustment if there is no `=` on the same line - // if there is an `=` the range will be adjusted during the tooltip creation - let r = Range.endToEnd pat.Range e1.Range - rcheck Scope.LetOrUseBang Collapse.Below r r - parseExpr e1 - parseExpr e2 + | SynExpr.LetOrUseBang (_, _, _, pat, eLet, es, eBody, _) -> + [ + yield eLet + yield! [ for (_,_,_,_,eAndBang,_) in es do yield eAndBang ] + ] + |> List.iter (fun e -> + // for `let!`, `use!` or `and!` the pattern begins at the end of the + // keyword so that this scope can be used without adjustment if there is no `=` + // on the same line. If there is an `=` the range will be adjusted during the + // tooltip creation + let r = Range.endToEnd pat.Range e.Range + rcheck Scope.LetOrUseBang Collapse.Below r r + parseExpr e + ) + parseExpr eBody | SynExpr.For (_, _, _, _, _, e, r) | SynExpr.ForEach (_, _, _, _, _, e, r) -> rcheck Scope.For Collapse.Below r r diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index f142279474..399b3e8791 100755 --- a/src/fsharp/service/ServiceUntypedParse.fs +++ b/src/fsharp/service/ServiceUntypedParse.fs @@ -322,9 +322,12 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op yield! walkExpr false e2 yield! walkExpr false e3 - | SynExpr.LetOrUseBang (spBind, _, _, _, e1, e2, _) -> + | SynExpr.LetOrUseBang (spBind, _, _, _, e1, es, e2, _) -> yield! walkBindSeqPt spBind yield! walkExpr true e1 + for (andBangSpBind,_,_,_,eAndBang,_) in es do + yield! walkBindSeqPt andBangSpBind + yield! walkExpr true eAndBang yield! walkExpr true e2 | SynExpr.MatchBang (spBind, e, cl, _) -> @@ -880,7 +883,14 @@ module UntypedParseImpl = | SynExpr.Match (_, e, synMatchClauseList, _) | SynExpr.MatchBang (_, e, synMatchClauseList, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkClause synMatchClauseList) - | SynExpr.LetOrUseBang (_, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.LetOrUseBang(_, _, _, _, e1, es, e2, _) -> + [ + yield e1 + for (_,_,_,_,eAndBang,_) in es do + yield eAndBang + yield e2 + ] + |> List.tryPick (walkExprWithKind parentKind) | SynExpr.DoBang (e, _) -> walkExprWithKind parentKind e | SynExpr.TraitCall (ts, sign, e, _) -> List.tryPick walkTypar ts diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index b4864ab1ef..3c20a47350 100755 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -12,7 +12,8 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader -open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.Ast open FSharp.Compiler.CompileOps @@ -742,7 +743,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC member bc.ParseAndCheckProject(options, userOpName) = reactor.EnqueueAndAwaitOpAsync(userOpName, "ParseAndCheckProject", options.ProjectFileName, fun ctok -> bc.ParseAndCheckProjectImpl(options, ctok, userOpName)) - member __.GetProjectOptionsFromScript(filename, sourceText, loadedTimeStamp, otherFlags, useFsiAuxLib: bool option, useSdkRefs: bool option, assumeDotNetFramework: bool option, extraProjectInfo: obj option, optionsStamp: int64 option, userOpName) = + member __.GetProjectOptionsFromScript(filename, sourceText, previewEnabled, loadedTimeStamp, otherFlags, useFsiAuxLib: bool option, useSdkRefs: bool option, assumeDotNetFramework: bool option, extraProjectInfo: obj option, optionsStamp: int64 option, userOpName) = reactor.EnqueueAndAwaitOpAsync (userOpName, "GetProjectOptionsFromScript", filename, fun ctok -> cancellable { use errors = new ErrorScope() @@ -751,10 +752,16 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let useFsiAuxLib = defaultArg useFsiAuxLib true let useSdkRefs = defaultArg useSdkRefs true let reduceMemoryUsage = ReduceMemoryFlag.Yes + let previewEnabled = defaultArg previewEnabled false // Do we assume .NET Framework references for scripts? let assumeDotNetFramework = defaultArg assumeDotNetFramework true - let otherFlags = defaultArg otherFlags [| |] + let extraFlags = + if previewEnabled then + [| "--langversion:preview" |] + else + [||] + let otherFlags = defaultArg otherFlags extraFlags let useSimpleResolution = #if ENABLE_MONO_SUPPORT runningOnMono || otherFlags |> Array.exists (fun x -> x = "--simpleresolution") @@ -1141,9 +1148,9 @@ type FSharpChecker(legacyReferenceResolver, backgroundCompiler.ParseAndCheckProject(options, userOpName) /// For a given script file, get the ProjectOptions implied by the #load closure - member __.GetProjectOptionsFromScript(filename, source, ?loadedTimeStamp, ?otherFlags, ?useFsiAuxLib, ?useSdkRefs, ?assumeDotNetFramework, ?extraProjectInfo: obj, ?optionsStamp: int64, ?userOpName: string) = + member __.GetProjectOptionsFromScript(filename, source, ?previewEnabled, ?loadedTimeStamp, ?otherFlags, ?useFsiAuxLib, ?useSdkRefs, ?assumeDotNetFramework, ?extraProjectInfo: obj, ?optionsStamp: int64, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetProjectOptionsFromScript(filename, source, loadedTimeStamp, otherFlags, useFsiAuxLib, useSdkRefs, assumeDotNetFramework, extraProjectInfo, optionsStamp, userOpName) + backgroundCompiler.GetProjectOptionsFromScript(filename, source, previewEnabled, loadedTimeStamp, otherFlags, useFsiAuxLib, useSdkRefs, assumeDotNetFramework, extraProjectInfo, optionsStamp, userOpName) member __.GetProjectOptionsFromCommandLineArgs(projectFileName, argv, ?loadedTimeStamp, ?extraProjectInfo: obj) = let loadedTimeStamp = defaultArg loadedTimeStamp DateTime.MaxValue // Not 'now', we don't want to force reloading diff --git a/src/fsharp/service/service.fsi b/src/fsharp/service/service.fsi index b64017a742..f22fdd71af 100755 --- a/src/fsharp/service/service.fsi +++ b/src/fsharp/service/service.fsi @@ -228,7 +228,7 @@ type public FSharpChecker = /// so that an 'unload' and 'reload' action will cause the script to be considered as a new project, /// so that references are re-resolved. /// An optional string used for tracing compiler operations associated with this request. - member GetProjectOptionsFromScript : filename: string * sourceText: ISourceText * ?loadedTimeStamp: DateTime * ?otherFlags: string[] * ?useFsiAuxLib: bool * ?useSdkRefs: bool * ?assumeDotNetFramework: bool * ?extraProjectInfo: obj * ?optionsStamp: int64 * ?userOpName: string -> Async + member GetProjectOptionsFromScript : filename: string * sourceText: ISourceText * ?previewEnabled:bool * ?loadedTimeStamp: DateTime * ?otherFlags: string[] * ?useFsiAuxLib: bool * ?useSdkRefs: bool * ?assumeDotNetFramework: bool * ?extraProjectInfo: obj * ?optionsStamp: int64 * ?userOpName: string -> Async /// /// Get the FSharpProjectOptions implied by a set of command line arguments. diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 48a44c8abb..39ca96934b 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -719,9 +719,9 @@ module internal SymbolHelpers = // In this case just bail out and assume items are not equal protectAssemblyExploration false (fun () -> let equalHeadTypes(ty1, ty2) = - match tryDestAppTy g ty1 with + match tryTcrefOfAppTy g ty1 with | ValueSome tcref1 -> - match tryDestAppTy g ty2 with + match tryTcrefOfAppTy g ty2 with | ValueSome tcref2 -> tyconRefEq g tcref1 tcref2 | _ -> typeEquiv g ty1 ty2 | _ -> typeEquiv g ty1 ty2 @@ -780,7 +780,7 @@ module internal SymbolHelpers = protectAssemblyExploration 1027 (fun () -> match item with | ItemWhereTypIsPreferred ty -> - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> hash tcref.LogicalName | _ -> 1010 | Item.ILField(ILFieldInfo(_, fld)) -> @@ -841,13 +841,13 @@ module internal SymbolHelpers = protectAssemblyExploration true (fun () -> match item with | Item.Types(it, [ty]) -> - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcr1 -> g.suppressed_types |> List.exists (fun supp -> let generalizedSupp = generalizedTyconRef supp // check the display name is precisely the one we're suppressing - match tryDestAppTy g generalizedSupp with + match tryTcrefOfAppTy g generalizedSupp with | ValueSome tcr2 -> it = supp.DisplayName && // check if they are the same logical type (after removing all abbreviations) @@ -895,7 +895,7 @@ module internal SymbolHelpers = | Item.FakeInterfaceCtor ty | Item.DelegateCtor ty | Item.Types(_, ty :: _) -> - match tryDestAppTy g ty with + match tryTcrefOfAppTy g ty with | ValueSome tcref -> bufs (fun os -> NicePrint.outputTyconRef denv os tcref) | _ -> "" | Item.ModuleOrNamespaces((modref :: _) as modrefs) -> diff --git a/src/utils/CompilerLocationUtils.fs b/src/utils/CompilerLocationUtils.fs index 923ab41843..20be5f7483 100755 --- a/src/utils/CompilerLocationUtils.fs +++ b/src/utils/CompilerLocationUtils.fs @@ -292,7 +292,6 @@ module internal FSharpEnvironment = // We look in the directories stepping up from the location of the runtime assembly. let loadFromLocation designTimeAssemblyPath = try - printfn "Using: %s" designTimeAssemblyPath Some (Assembly.UnsafeLoadFrom designTimeAssemblyPath) with e -> raiseError e @@ -315,8 +314,6 @@ module internal FSharpEnvironment = let runTimeAssemblyPath = Path.GetDirectoryName runTimeAssemblyFileName let paths = searchParentDirChain (Some runTimeAssemblyPath) designTimeAssemblyName paths - |> Seq.iter(function res -> printfn ">>>> %s" res) - paths |> Seq.tryHead |> function | Some res -> loadFromLocation res @@ -325,7 +322,6 @@ module internal FSharpEnvironment = let runTimeAssemblyPath = Path.GetDirectoryName runTimeAssemblyFileName loadFromLocation (Path.Combine (runTimeAssemblyPath, designTimeAssemblyName)) - printfn "=============== S T A R T ==========================================" if designTimeAssemblyName.EndsWith(".dll", StringComparison.OrdinalIgnoreCase) then loadFromParentDirRelativeToRuntimeAssemblyLocation designTimeAssemblyName else diff --git a/tests/fsharp/Compiler/Language/UIntTests.fs b/tests/fsharp/Compiler/Language/UIntTests.fs deleted file mode 100644 index c317f96e02..0000000000 --- a/tests/fsharp/Compiler/Language/UIntTests.fs +++ /dev/null @@ -1,10 +0,0 @@ -namespace FSharp.Compiler.UnitTests - -open NUnit.Framework - -[] -module UIntTests = - let ``uint type abbreviation works`` () = - let src = "let x = uint 12" - let expectedErrors = [||] - CompilerAssert.TypeCheckWithErrors src expectedErrors \ No newline at end of file diff --git a/tests/fsharp/perf/computation-expressions/dependency_graph.fsx b/tests/fsharp/perf/computation-expressions/dependency_graph.fsx new file mode 100644 index 0000000000..348aab0349 --- /dev/null +++ b/tests/fsharp/perf/computation-expressions/dependency_graph.fsx @@ -0,0 +1,192 @@ + +let mutable nodes = 0 +let mutable recalcs = 0 + +[] +type Node(dirty) = + do nodes <- nodes + 1 + + let dependees = ResizeArray>() + let mutable dirty = dirty + + member _.Dirty with get() = dirty and set v = dirty <- v + + member _.Dependees = + dependees.ToArray() + |> Array.choose (fun c -> match c.TryGetTarget() with true, tg -> Some tg | _ -> None) + + member _.AddDependee(c) = + dependees.Add(System.WeakReference<_>(c)) + + member _.InputChanged() = + for c in dependees do + match c.TryGetTarget() with + | true, tg -> tg.SetDirty() + | _ -> () + + member n.SetDirty() = + if not dirty then + dirty <- true + n.InputChanged() + + +[] +type Node<'T>(dirty) = + inherit Node(dirty) + abstract Value : 'T + +/// A node that recomputes if any if its inputs change +type RecalcNode<'T>(dirty, initial, f: unit -> 'T) = + inherit Node<'T>(dirty) + + let mutable cachedValue = initial + + new (f) = new RecalcNode<'T>(true, Unchecked.defaultof<_>, f) + + new (initial, f) = new RecalcNode<'T>(false, initial, f) + + override n.Value = + if n.Dirty then + recalcs <- recalcs + 1 + cachedValue <- f() + n.Dirty <- false + cachedValue + + override _.ToString() = sprintf "(latest %A)" cachedValue + +/// A node that never recomputes +type ConstantNode<'T>(x: 'T) = + inherit Node<'T>(false) + + override _.Value = x + + override _.ToString() = sprintf "(latest %A)" x + +type InputNode<'T>(v: 'T) = + inherit Node<'T>(false) + let mutable currentValue = v + override _.Value = currentValue + + member node.SetValue v = + currentValue <- v + node.InputChanged() + +type NodeBuilder() = + + member _.Bind(x: Node<'T1>, f: 'T1 -> Node<'T2>) : Node<'T2> = + let rec n = + RecalcNode<'T2>(fun () -> + let n2 = f x.Value + n2.AddDependee(n) + n2.Value) + x.AddDependee(n) + n :> Node<_> + + member _.BindReturn(x: Node<'T1>, f: 'T1 -> 'T2) : Node<'T2> = + let n = RecalcNode<'T2>(fun () -> f x.Value) + x.AddDependee(n) + n :> Node<_> + + member _.Bind2(x1: Node<'T1>, x2: Node<'T2>, f: 'T1 * 'T2 -> Node<'T3>) : Node<'T3> = + let rec n = + RecalcNode<'T3>(fun () -> + let n2 = f (x1.Value, x2.Value) + n2.AddDependee(n) + n2.Value) + x1.AddDependee(n) + x2.AddDependee(n) + n :> Node<_> + + member _.Bind2Return(x1: Node<'T1>, x2: Node<'T2>, f: 'T1 * 'T2 -> 'T3) : Node<'T3> = + let n = RecalcNode<'T3>(fun () -> f (x1.Value, x2.Value)) + x1.AddDependee(n) + x2.AddDependee(n) + n :> Node<_> + + member _.Bind3(x1: Node<'T1>, x2: Node<'T2>, x3: Node<'T3>, f: 'T1 * 'T2 * 'T3 -> Node<'T4>) : Node<'T4> = + let rec n = + RecalcNode<'T4>(fun () -> + let n2 = f (x1.Value, x2.Value, x3.Value) + n2.AddDependee(n) + n2.Value) + x1.AddDependee(n) + x2.AddDependee(n) + x3.AddDependee(n) + n :> Node<_> + + member _.Bind3Return(x1: Node<'T1>, x2: Node<'T2>, x3: Node<'T3>, f: 'T1 * 'T2 * 'T3 -> 'T4) : Node<'T4> = + let n = RecalcNode<'T4>(fun () -> f (x1.Value, x2.Value, x3.Value)) + x1.AddDependee(n) + x2.AddDependee(n) + x3.AddDependee(n) + n :> Node<_> + + member _.MergeSources(x1: Node<'T1>, x2: Node<'T2>) : Node<'T1 * 'T2> = + let n = RecalcNode<_>(fun () -> (x1.Value, x2.Value)) + x1.AddDependee(n) + x2.AddDependee(n) + n :> Node<_> + + member _.Return(x: 'T) : Node<'T> = + ConstantNode<'T>(x) :> Node<_> + +let node = NodeBuilder() +let input v = InputNode(v) + +let inp1 = input 3 +let inp2 = input 7 +let inp3 = input 0 + +let test1() = + node { + let! v1 = inp1 + and! v2 = inp2 + and! v3 = inp3 + return v1 + v2 + v3 + } + //let n1 = node.Bind3Return(inp1.Node, inp2.Node, inp3.Node, (fun (v1, v2, v3) -> v1 + v2 + v3)) + +let test2() = + node { + let! v1 = inp1 + let! v2 = inp2 + let! v3 = inp3 + return v1 + v2 + v3 + } + +let test msg f = + recalcs <- 0 + nodes <- 0 + + let (n: Node) = f() + + let v1 = n.Value // now 10 + + recalcs <- 0 + + for i in 1 .. 1000 do + inp1.SetValue 4 + let v2 = n.Value // now 11 + + inp2.SetValue 10 + let v3 = n.Value // now 14 + () + + printfn "inp1.Dependees.Length = %d" inp1.Dependees.Length + printfn "inp2.Dependees.Length = %d" inp2.Dependees.Length + printfn "total recalcs %s = %d" msg recalcs + printfn "total nodes %s = %d" msg nodes + printfn "----" + +test "using and!" test1 +test "using let!" test2 + +//inp1.Dependees.Length = 1 +//inp2.Dependees.Length = 1 +//total recalcs using and! = 2000 +//total nodes using and! = 1 +//---- +//inp1.Dependees.Length = 1 +//inp2.Dependees.Length = 2000 +//total recalcs using let! = 6000 +//total nodes using let! = 4003 \ No newline at end of file diff --git a/tests/service/ScriptOptionsTests.fs b/tests/service/ScriptOptionsTests.fs new file mode 100644 index 0000000000..a43731db32 --- /dev/null +++ b/tests/service/ScriptOptionsTests.fs @@ -0,0 +1,34 @@ +#if INTERACTIVE +#r "../../artifacts/bin/fcs/net461/FSharp.Compiler.Service.dll" // note, build FSharp.Compiler.Service.Tests.fsproj to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../artifacts/bin/fcs/net461/nunit.framework.dll" +#load "FsUnit.fs" +#load "Common.fs" +#else +module Tests.Service.ScriptOptions +#endif + +open NUnit.Framework +open FsUnit +open System +open FSharp.Compiler +open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.Service.Tests.Common + +let scriptSource = """ +open System +let pi = Math.PI +""" + +[] +[] +[] +let ``can generate options for different frameworks regardless of execution environment``(assumeNetFx, useSdk, flags) = + let path = IO.Path.GetTempPath() + let file = IO.Path.GetTempFileName() + let tempFile = IO.Path.Combine(path, file) + let (options, errors) = + checker.GetProjectOptionsFromScript(tempFile, Text.SourceText.ofString scriptSource, assumeDotNetFramework = assumeNetFx, useSdkRefs = useSdk, otherFlags = flags) + |> Async.RunSynchronously + match errors with + | [] -> () + | errors -> failwithf "Error while parsing script with assumeDotNetFramework:%b, useSdkRefs:%b, and otherFlags:%A:\n%A" assumeNetFx useSdk flags errors \ No newline at end of file