Support empty-bodied computation expressions (#17352)

docs/release-notes/.FSharp.Compiler.Service/8.0.400.md

@@ -27,6 +27,7 @@
 * Parser: better recovery for unfinished patterns ([PR #17231](https://github.com/dotnet/fsharp/pull/17231))
 * Expose inner exception information of TypeProviders to help diagnostics in IDE ([PR #17251](https://github.com/dotnet/fsharp/pull/17251))
 * Parser: recover on empty match clause ([PR #17233](https://github.com/dotnet/fsharp/pull/17233))
+* Support empty-bodied computation expressions. ([Language suggestion #1232](https://github.com/fsharp/fslang-suggestions/issues/1232), [RFC FS-1144 (PR #774)](https://github.com/fsharp/fslang-design/pull/774), [PR #17352](https://github.com/dotnet/fsharp/pull/17352))
 
 ### Changed
 * Enforce `AttributeTargets.Interface` ([PR #17173](https://github.com/dotnet/fsharp/pull/17173))

docs/release-notes/.Language/preview.md

@@ -8,6 +8,7 @@
 * Allow returning bool instead of unit option for partial active patterns. ([Language suggestion #1041](https://github.com/fsharp/fslang-suggestions/issues/1041), [PR #16473](https://github.com/dotnet/fsharp/pull/16473))
 * Allow #nowarn to support the FS prefix on error codes to disable warnings ([Issue #17206](https://github.com/dotnet/fsharp/issues/16447), [PR #17209](https://github.com/dotnet/fsharp/pull/17209))
 * Allow ParsedHashDirectives to have argument types other than strings ([Issue #17240](https://github.com/dotnet/fsharp/issues/16447), [PR #17209](https://github.com/dotnet/fsharp/pull/17209))
+* Support empty-bodied computation expressions. ([Language suggestion #1232](https://github.com/fsharp/fslang-suggestions/issues/1232), [PR #17352](https://github.com/dotnet/fsharp/pull/17352))
 
 ### Fixed
 

src/Compiler/Checking/CheckComputationExpressions.fs

@@ -1086,6 +1086,8 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
             && hasMethInfo "Delay"
             && YieldFree cenv comp)
 
+    let origComp = comp
+
     /// <summary>
     /// Try translate the syntax sugar
     /// </summary>
@@ -1633,7 +1635,19 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
                     (not enableImplicitYield)
                     && isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Zero" builderTy)
                 then
-                    error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), m))
+                    match origComp with
+                    // builder { }
+                    //
+                    // The compiler inserts a dummy () in CheckExpressions.fs for
+                    // empty-bodied computation expressions. In this case, the user
+                    // has not actually written any "control construct" in the body,
+                    // and so we use a more specific error message for clarity.
+                    | SynExpr.Const(SynConst.Unit, mUnit) when
+                        g.langVersion.SupportsFeature LanguageFeature.EmptyBodiedComputationExpressions
+                        && Range.equals mUnit range0
+                        ->
+                        error (Error(FSComp.SR.tcEmptyBodyRequiresBuilderZeroMethod (), mWhole))
+                    | _ -> error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), m))
 
                 Some(translatedCtxt (mkSynCall "Zero" m []))
 

src/Compiler/Checking/CheckExpressions.fs

@@ -8189,6 +8189,10 @@ and Propagate (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) tpenv (expr: Appl
                 // seq { ... }
                 | SynExpr.ComputationExpr _ -> ()
 
+                // async { }
+                // seq { }
+                | SynExpr.Record (None, None, [], _) when g.langVersion.SupportsFeature LanguageFeature.EmptyBodiedComputationExpressions -> ()
+
                 // expr[idx]
                 // expr[idx1, idx2]
                 // expr[idx1..]
@@ -8453,6 +8457,16 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg
     let mArg = synArg.Range
     let mLeftExpr = leftExpr.Range
 
+    /// Treat an application of a value to an empty record expression
+    /// as a computation expression with a single unit expression.
+    /// Insert a (), i.e., such that builder { } ≡ builder { () }.
+    /// This transformation is only valid for language
+    /// versions that support this feature.
+    let (|EmptyFieldListAsUnit|_|) recordFields =
+        match recordFields with
+        | [] when g.langVersion.SupportsFeature LanguageFeature.EmptyBodiedComputationExpressions -> Some (EmptyFieldListAsUnit (SynExpr.Const (SynConst.Unit, range0)))
+        | _ -> None
+
     // If the type of 'synArg' unifies as a function type, then this is a function application, otherwise
     // it is an error or a computation expression or indexer or delegate invoke
     match UnifyFunctionTypeUndoIfFailed cenv denv mLeftExpr exprTy with
@@ -8474,11 +8488,15 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg
             // though users don't realise that.
             let synArg =
                 match synArg with
-                | SynExpr.ComputationExpr (false, comp, m) when 
+                // seq { comp }
+                // seq { }
+                | SynExpr.ComputationExpr (false, comp, m)
+                | SynExpr.Record (None, None, EmptyFieldListAsUnit comp, m) when
                         (match leftExpr with
                          | ApplicableExpr(expr=Expr.Op(TOp.Coerce, _, [SeqExpr g], _)) -> true
                          | _ -> false) ->
                     SynExpr.ComputationExpr (true, comp, m)
+
                 | _ -> synArg
 
             let arg, tpenv =
@@ -8519,8 +8537,11 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg
                 | _ -> None, delayed
             TcIndexingThen cenv env overallTy mExprAndArg m tpenv setInfo synLeftExprOpt leftExpr.Expr exprTy expandedIndexArgs indexArgs delayed
 
-        // Perhaps 'leftExpr' is a computation expression builder, and 'arg' is '{ ... }'
-        | SynExpr.ComputationExpr (false, comp, _m) ->
+        // Perhaps 'leftExpr' is a computation expression builder, and 'arg' is '{ ... }' or '{ }':
+        // leftExpr { comp }
+        // leftExpr { }
+        | SynExpr.ComputationExpr (false, comp, _m)
+        | SynExpr.Record (None, None, EmptyFieldListAsUnit comp, _m) ->
             let bodyOfCompExpr, tpenv = cenv.TcComputationExpression cenv env overallTy tpenv (mLeftExpr, leftExpr.Expr, exprTy, comp)
             TcDelayed cenv overallTy env tpenv mExprAndArg (MakeApplicableExprNoFlex cenv bodyOfCompExpr) (tyOfExpr g bodyOfCompExpr) ExprAtomicFlag.NonAtomic delayed
 

src/Compiler/FSComp.txt

@@ -561,6 +561,7 @@ tcCouldNotFindIDisposable,"Couldn't find Dispose on IDisposable, or it was overl
 706,tcInvalidUnitsOfMeasurePrefix,"Units-of-measure cannot be used as prefix arguments to a type. Rewrite as postfix arguments in angle brackets."
 707,tcUnitsOfMeasureInvalidInTypeConstructor,"Unit-of-measure cannot be used in type constructor application"
 708,tcRequireBuilderMethod,"This control construct may only be used if the computation expression builder defines a '%s' method"
+708,tcEmptyBodyRequiresBuilderZeroMethod,"An empty body may only be used if the computation expression builder defines a 'Zero' method."
 709,tcTypeHasNoNestedTypes,"This type has no nested types"
 711,tcUnexpectedSymbolInTypeExpression,"Unexpected %s in type expression"
 712,tcTypeParameterInvalidAsTypeConstructor,"Type parameter cannot be used as type constructor"
@@ -1755,3 +1756,4 @@ featureReuseSameFieldsInStructUnions,"Share underlying fields in a [<Struct>] di
 featureParsedHashDirectiveArgumentNonString,"# directives with non-quoted string arguments"
 3869,featureParsedHashDirectiveUnexpectedInteger,"Unexpected integer literal '%d'."
 3869,featureParsedHashDirectiveUnexpectedIdentifier,"Unexpected identifier '%s'."
+featureEmptyBodiedComputationExpressions,"Support for computation expressions with empty bodies: builder {{ }}"

src/Compiler/Facilities/LanguageFeatures.fs

@@ -90,6 +90,7 @@ type LanguageFeature =
     | LowerIntegralRangesToFastLoops
     | LowerSimpleMappingsInComprehensionsToDirectCallsToMap
     | ParsedHashDirectiveArgumentNonQuotes
+    | EmptyBodiedComputationExpressions
 
 /// LanguageVersion management
 type LanguageVersion(versionText) =
@@ -207,6 +208,7 @@ type LanguageVersion(versionText) =
                 LanguageFeature.LowerIntegralRangesToFastLoops, previewVersion
                 LanguageFeature.LowerSimpleMappingsInComprehensionsToDirectCallsToMap, previewVersion
                 LanguageFeature.ParsedHashDirectiveArgumentNonQuotes, previewVersion
+                LanguageFeature.EmptyBodiedComputationExpressions, previewVersion
             ]
 
     static let defaultLanguageVersion = LanguageVersion("default")
@@ -356,6 +358,7 @@ type LanguageVersion(versionText) =
         | LanguageFeature.LowerSimpleMappingsInComprehensionsToDirectCallsToMap ->
             FSComp.SR.featureLowerSimpleMappingsInComprehensionsToDirectCallsToMap ()
         | LanguageFeature.ParsedHashDirectiveArgumentNonQuotes -> FSComp.SR.featureParsedHashDirectiveArgumentNonString ()
+        | LanguageFeature.EmptyBodiedComputationExpressions -> FSComp.SR.featureEmptyBodiedComputationExpressions ()
 
     /// Get a version string associated with the given feature.
     static member GetFeatureVersionString feature =

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -81,6 +81,7 @@ type LanguageFeature =
     | LowerIntegralRangesToFastLoops
     | LowerSimpleMappingsInComprehensionsToDirectCallsToMap
     | ParsedHashDirectiveArgumentNonQuotes
+    | EmptyBodiedComputationExpressions
 
 /// LanguageVersion management
 type LanguageVersion =