diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md index 3eb14e5457c..701b6c0d2cc 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md @@ -6,6 +6,7 @@ * Limit a type to 65K methods, introduce a compile-time error if any class has over approx 64K methods in generated IL. ([Issue #16398](https://github.com/dotnet/fsharp/issues/16398), [#PR 16427](https://github.com/dotnet/fsharp/pull/16427)) ### Added + * Raise a new error when interfaces with auto properties are implemented on constructor-less types. ([PR #16352](https://github.com/dotnet/fsharp/pull/16352)) * Allow usage of `[]` with older `FSharp.Core` package versions. ([PR #16373](https://github.com/dotnet/fsharp/pull/16373)) * Parser recovers on unfinished `as` patterns. ([PR #16404](https://github.com/dotnet/fsharp/pull/16404)) @@ -13,3 +14,4 @@ * Parser recovers on unfinished enum case declarations. ([PR #16401](https://github.com/dotnet/fsharp/pull/16401)) * Parser recovers on unfinished record declarations. ([PR #16357](https://github.com/dotnet/fsharp/pull/16357)) * `MutableKeyword` to [SynFieldTrivia](../reference/fsharp-compiler-syntaxtrivia-synfieldtrivia.html) ([PR #16357](https://github.com/dotnet/fsharp/pull/16357)) +* Added support for a new parameterless constructor for `CustomOperationAttribute`, which, when applied, will use method name as keyword for custom operation in computation expression builder. ([PR #16475](https://github.com/dotnet/fsharp/pull/16475), part of implementation for [fslang-suggestions/1250](https://github.com/fsharp/fslang-suggestions/issues/1250)) diff --git a/docs/release-notes/.FSharp.Core/8.0.200.md b/docs/release-notes/.FSharp.Core/8.0.200.md index e927a03a062..8a1feafaf64 100644 --- a/docs/release-notes/.FSharp.Core/8.0.200.md +++ b/docs/release-notes/.FSharp.Core/8.0.200.md @@ -1,3 +1,4 @@ ### Added * More inlines for Result module. ([PR #16106](https://github.com/dotnet/fsharp/pull/16106)) +* Added a new parameterless constructor for `CustomOperationAttribute` ([PR #16475](https://github.com/dotnet/fsharp/pull/16475), part of implementation for [fslang-suggestions/1250](https://github.com/fsharp/fslang-suggestions/issues/1250)) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 2f02f794e8b..2564a54bdd3 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -207,7 +207,7 @@ let TryBindMethInfoAttribute g (m: range) (AttribInfo(atref, _) as attribSpec) m (fun provAttribs -> match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), atref.FullName)), m) with | Some args -> f3 args - | None -> None) + | None -> None) #else (fun _provAttribs -> None) #endif diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index 2dfee741233..f1900f7a166 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -266,14 +266,25 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol /// Decide if the builder is an auto-quote builder let isAutoQuote = hasMethInfo "Quote" - let customOperationMethods = + let customOperationMethods = AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults cenv.infoReader env.NameEnv None ad IgnoreOverrides mBuilderVal builderTy - |> List.choose (fun methInfo -> + |> List.choose (fun methInfo -> if not (IsMethInfoAccessible cenv.amap mBuilderVal ad methInfo) then None else - let nameSearch = - TryBindMethInfoAttribute cenv.g mBuilderVal cenv.g.attrib_CustomOperationAttribute methInfo + let nameSearch = + TryBindMethInfoAttribute cenv.g mBuilderVal cenv.g.attrib_CustomOperationAttribute methInfo IgnoreAttribute // We do not respect this attribute for IL methods - (function Attrib(_, _, [ AttribStringArg msg ], _, _, _, _) -> Some msg | _ -> None) + (fun attr -> + // NOTE: right now, we support of custom operations with spaces in them ([]) + // In the parameterless CustomOperationAttribute - we use the method name, and also allow it to be ````-quoted (member _.``foo bar`` _ = ...) + match attr with + // Empty string and parameterless constructor - we use the method name + | Attrib(_, _, [ AttribStringArg "" ], _, _, _, _) // Empty string as parameter + | Attrib(_, _, [ ], _, _, _, _) -> // No parameters, same as empty string for compat reasons. + Some methInfo.LogicalName + // Use the specified name + | Attrib(_, _, [ AttribStringArg msg ], _, _, _, _) -> + Some msg + | _ -> None) IgnoreAttribute // We do not respect this attribute for provided methods match nameSearch with diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index 7693d7e6441..6d6eaf10a5c 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -287,6 +287,7 @@ namespace Microsoft.FSharp.Core let mutable maintainsVarSpace = false let mutable maintainsVarSpaceWithBind = false let mutable joinOnWord = "" + new() = CustomOperationAttribute("") member _.Name = name member _.AllowIntoPattern with get() = allowInto and set v = allowInto <- v member _.IsLikeZip with get() = isBinary and set v = isBinary <- v diff --git a/src/FSharp.Core/prim-types.fsi b/src/FSharp.Core/prim-types.fsi index 1daa1017737..655a31a8c87 100644 --- a/src/FSharp.Core/prim-types.fsi +++ b/src/FSharp.Core/prim-types.fsi @@ -420,6 +420,10 @@ namespace Microsoft.FSharp.Core /// CustomOperationAttribute new: name:string -> CustomOperationAttribute + /// Create an instance of attribute with empty name + /// CustomOperationAttribute + new: unit -> CustomOperationAttribute + /// Get the name of the custom operation when used in a query or other computation expression member Name: string diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ComputationExpressions/CustomOperations.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ComputationExpressions/CustomOperations.fs new file mode 100644 index 00000000000..28e9ff22c7a --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ComputationExpressions/CustomOperations.fs @@ -0,0 +1,43 @@ +namespace Conformance.Expressions.ComputationExpressions + +open Xunit +open FSharp.Test.Compiler + +module CustomOperations = + + [] + let ``[] without explicit name is allowed, uses method name as operation name`` () = + FSharp """ + module CustomOperationTest + type CBuilder() = + [] + member this.Foo _ = "Foo" + [] + member this.foo _ = "foo" + [] + member this.bar _ = "bar" + member this.Yield _ = () + member this.Zero _ = () + + + [] + let main _ = + let cb = CBuilder() + + let x = cb { Foo } + let y = cb { foo } + let z = cb { bar } + printfn $"{x}" + printfn $"{y}" + + if x <> "Foo" then + failwith "not Foo" + if y <> "foo" then + failwith "not foo" + if z <> "bar" then + failwith "not bar" + 0 + """ + |> asExe + |> compileAndRun + |> shouldSucceed \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index a46a34a1160..904fbbf731c 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -31,53 +31,77 @@ FsUnit.fs - - - - - + + + + + - - + + - + - + - + - - + + - - - - - - + + + + + + - + - + - - - + + + - + + diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.debug.bsl index e677bf9a8c7..5a36ea3c288 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.debug.bsl @@ -950,6 +950,7 @@ Microsoft.FSharp.Core.CustomOperationAttribute: System.String JoinConditionWord Microsoft.FSharp.Core.CustomOperationAttribute: System.String Name Microsoft.FSharp.Core.CustomOperationAttribute: System.String get_JoinConditionWord() Microsoft.FSharp.Core.CustomOperationAttribute: System.String get_Name() +Microsoft.FSharp.Core.CustomOperationAttribute: Void .ctor() Microsoft.FSharp.Core.CustomOperationAttribute: Void .ctor(System.String) Microsoft.FSharp.Core.CustomOperationAttribute: Void set_AllowIntoPattern(Boolean) Microsoft.FSharp.Core.CustomOperationAttribute: Void set_IsLikeGroupJoin(Boolean) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.release.bsl index 0d4c37a6541..b4cb84825db 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard20.release.bsl @@ -952,6 +952,7 @@ Microsoft.FSharp.Core.CustomOperationAttribute: System.String JoinConditionWord Microsoft.FSharp.Core.CustomOperationAttribute: System.String Name Microsoft.FSharp.Core.CustomOperationAttribute: System.String get_JoinConditionWord() Microsoft.FSharp.Core.CustomOperationAttribute: System.String get_Name() +Microsoft.FSharp.Core.CustomOperationAttribute: Void .ctor() Microsoft.FSharp.Core.CustomOperationAttribute: Void .ctor(System.String) Microsoft.FSharp.Core.CustomOperationAttribute: Void set_AllowIntoPattern(Boolean) Microsoft.FSharp.Core.CustomOperationAttribute: Void set_IsLikeGroupJoin(Boolean) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl index b6b6b11aae7..adc21566d87 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl @@ -672,12 +672,14 @@ Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Microsoft.FSharp.Contro Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Microsoft.FSharp.Control.FSharpAsync`1[T] Scan[T](Microsoft.FSharp.Core.FSharpFunc`2[TMsg,Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Control.FSharpAsync`1[T]]], Microsoft.FSharp.Core.FSharpOption`1[System.Int32]) Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Microsoft.FSharp.Control.FSharpHandler`1[System.Exception] Error Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg] Start(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg],Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit]], Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) +Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg] StartImmediate(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg],Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit]], Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Microsoft.FSharp.Core.FSharpOption`1[TReply] TryPostAndReply[TReply](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1[TReply],TMsg], Microsoft.FSharp.Core.FSharpOption`1[System.Int32]) Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: TReply PostAndReply[TReply](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1[TReply],TMsg], Microsoft.FSharp.Core.FSharpOption`1[System.Int32]) Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg],Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit]], Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Void Dispose() Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Void Post(TMsg) Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Void Start() +Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Void StartImmediate() Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Void add_Error(Microsoft.FSharp.Control.FSharpHandler`1[System.Exception]) Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Void remove_Error(Microsoft.FSharp.Control.FSharpHandler`1[System.Exception]) Microsoft.FSharp.Control.FSharpMailboxProcessor`1[TMsg]: Void set_DefaultTimeout(Int32) @@ -951,6 +953,7 @@ Microsoft.FSharp.Core.CustomOperationAttribute: System.String JoinConditionWord Microsoft.FSharp.Core.CustomOperationAttribute: System.String Name Microsoft.FSharp.Core.CustomOperationAttribute: System.String get_JoinConditionWord() Microsoft.FSharp.Core.CustomOperationAttribute: System.String get_Name() +Microsoft.FSharp.Core.CustomOperationAttribute: Void .ctor() Microsoft.FSharp.Core.CustomOperationAttribute: Void .ctor(System.String) Microsoft.FSharp.Core.CustomOperationAttribute: Void set_AllowIntoPattern(Boolean) Microsoft.FSharp.Core.CustomOperationAttribute: Void set_IsLikeGroupJoin(Boolean) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.release.bsl b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.release.bsl index baecd0a2364..eba99c47dec 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.release.bsl +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.release.bsl @@ -953,6 +953,7 @@ Microsoft.FSharp.Core.CustomOperationAttribute: System.String JoinConditionWord Microsoft.FSharp.Core.CustomOperationAttribute: System.String Name Microsoft.FSharp.Core.CustomOperationAttribute: System.String get_JoinConditionWord() Microsoft.FSharp.Core.CustomOperationAttribute: System.String get_Name() +Microsoft.FSharp.Core.CustomOperationAttribute: Void .ctor() Microsoft.FSharp.Core.CustomOperationAttribute: Void .ctor(System.String) Microsoft.FSharp.Core.CustomOperationAttribute: Void set_AllowIntoPattern(Boolean) Microsoft.FSharp.Core.CustomOperationAttribute: Void set_IsLikeGroupJoin(Boolean) diff --git a/tests/projects/Sample_Local_Compiler_and_FSLib/LocalCompilerAndFslib.fsproj b/tests/projects/Sample_Local_Compiler_and_FSLib/LocalCompilerAndFslib.fsproj new file mode 100644 index 00000000000..c2164b65666 --- /dev/null +++ b/tests/projects/Sample_Local_Compiler_and_FSLib/LocalCompilerAndFslib.fsproj @@ -0,0 +1,23 @@ + + + + Exe + net8.0 + preview + true + + + + true + $(MSBuildThisFileDirectory)../../../artifacts/bin/fsc/Debug/net8.0/fsc.dll + $(MSBuildThisFileDirectory)../../../artifacts/bin/fsc/Debug/net8.0/fsc.dll + False + True + + + + + + + + diff --git a/tests/projects/Sample_Local_Compiler_and_FSLib/Program.fs b/tests/projects/Sample_Local_Compiler_and_FSLib/Program.fs new file mode 100644 index 00000000000..1ffa8063569 --- /dev/null +++ b/tests/projects/Sample_Local_Compiler_and_FSLib/Program.fs @@ -0,0 +1,25 @@ +module Program + +type CBuilder() = + [] + member this.Foo _ = "Foo" + [] + member this.foo _ = "foo" + member this.Yield _ = () + member this.Zero _ = () + + +[] +let main _ = + let cb = CBuilder() + + let x = cb { Foo } + let y = cb { foo } + printfn $"{x}" + printfn $"{y}" + + if x <> "Foo" then + failwith "not Foo" + if y <> "foo" then + failwith "not foo" + 0