[RFC FS-1069] Implicit yields (allow dropping yield in list, array, sequence and computation expressions)

src/fsharp/ConstraintSolver.fs

@@ -2678,9 +2678,26 @@ let UndoIfFailed f =
         ReportWarnings warns
         true
 
+let UndoIfFailedOrWarnings f =
+    let trace = Trace.New()
+    let res = 
+        try 
+            f trace 
+            |> CheckNoErrorsAndGetWarnings
+        with e -> None
+    match res with 
+    | Some [] -> 
+        true
+    | _ -> 
+        trace.Undo()
+        false
+
 let AddCxTypeEqualsTypeUndoIfFailed denv css m ty1 ty2 =
     UndoIfFailed (fun trace -> SolveTypeEqualsTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) ty1 ty2)
 
+let AddCxTypeEqualsTypeUndoIfFailedOrWarnings denv css m ty1 ty2 =
+    UndoIfFailedOrWarnings (fun trace -> SolveTypeEqualsTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) ty1 ty2)
+
 let AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed denv css m ty1 ty2 =
     let csenv = { MakeConstraintSolverEnv ContextInfo.NoContext css m denv with MatchingOnly = true }
     UndoIfFailed (fun trace -> SolveTypeEqualsTypeKeepAbbrevs csenv 0 m (WithTrace trace) ty1 ty2)

src/fsharp/ConstraintSolver.fsi

@@ -125,6 +125,7 @@ val CheckDeclaredTypars                       : DisplayEnv -> ConstraintSolverSt
 val AddConstraint                             : ConstraintSolverEnv -> int -> Range.range -> OptionalTrace -> Typar -> TyparConstraint -> OperationResult<unit>
 val AddCxTypeEqualsType                       : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit
 val AddCxTypeEqualsTypeUndoIfFailed           : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
+val AddCxTypeEqualsTypeUndoIfFailedOrWarnings : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
 val AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
 val AddCxTypeMustSubsumeType                  : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit
 val AddCxTypeMustSubsumeTypeUndoIfFailed      : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool

src/fsharp/FSComp.txt

@@ -572,7 +572,7 @@ tcUseWhenPatternGuard,"Character range matches have been removed in F#. Consider
 736,tcExprUndelayed,"TcExprUndelayed: delayed"
 737,tcExpressionRequiresSequence,"This expression form may only be used in sequence and computation expressions"
 738,tcInvalidObjectExpressionSyntaxForm,"Invalid object expression. Objects without overrides or interfaces should use the expression form 'new Type(args)' without braces."
-739,tcInvalidObjectSequenceOrRecordExpression,"Invalid object, sequence or record expression"
+#739,tcInvalidObjectSequenceOrRecordExpression,"Invalid object, sequence or record expression"
 740,tcInvalidSequenceExpressionSyntaxForm,"Invalid record, sequence or computation expression. Sequence expressions should be of the form 'seq {{ ... }}'"
 tcExpressionWithIfRequiresParenthesis,"This list or array expression includes an element of the form 'if ... then ... else'. Parenthesize this expression to indicate it is an individual element of the list or array, to disambiguate this from a list generated using a sequence expression"
 741,tcUnableToParseFormatString,"Unable to parse format string '%s'"

src/fsharp/ast.fs

@@ -671,7 +671,7 @@ and
     /// F# syntax: lazy expr
     | Lazy of SynExpr * range: range
 
-    /// Seq(seqPoint, isTrueSeq, e1, e2, m)
+    /// Sequential(seqPoint, isTrueSeq, e1, e2, m)
     ///  isTrueSeq: false indicates "let v = a in b; v"
     ///
     /// F# syntax: expr; expr
@@ -749,10 +749,12 @@ and
     /// Computation expressions only, based on JOIN_IN token from lex filter
     | JoinIn of SynExpr * range * SynExpr * range: range
 
-    /// F# syntax: <implicit>
-    /// Computation expressions only, implied by final "do" or "do!"
+    /// Used internally during type checking for translating computation expressions.
     | ImplicitZero of range: range
 
+    /// Used internally during type checking for translating computation expressions.
+    | SequentialOrImplicitYield of seqPoint:SequencePointInfoForSeq * expr1:SynExpr * expr2:SynExpr * ifNotStmt:SynExpr * range:range
+
     /// F# syntax: yield expr
     /// F# syntax: return expr
     /// Computation expressions only
@@ -833,6 +835,7 @@ and
         | SynExpr.TryWith (range=m)
         | SynExpr.TryFinally (range=m)
         | SynExpr.Sequential (range=m)
+        | SynExpr.SequentialOrImplicitYield (range=m)
         | SynExpr.ArbitraryAfterError (range=m)
         | SynExpr.FromParseError (range=m)
         | SynExpr.DiscardAfterMissingQualificationAfterDot (range=m)
@@ -872,138 +875,25 @@ and
     /// range ignoring any (parse error) extra trailing dots
     member e.RangeSansAnyExtraDot =
         match e with
-        | SynExpr.Paren (range=m)
-        | SynExpr.Quote (range=m)
-        | SynExpr.Const (range=m)
-        | SynExpr.Typed (range=m)
-        | SynExpr.Tuple (range=m)
-        | SynExpr.ArrayOrList (range=m)
-        | SynExpr.AnonRecd (range=m)
-        | SynExpr.Record (range=m)
-        | SynExpr.New (range=m)
-        | SynExpr.ObjExpr (range=m)
-        | SynExpr.While (range=m)
-        | SynExpr.For (range=m)
-        | SynExpr.ForEach (range=m)
-        | SynExpr.CompExpr (range=m)
-        | SynExpr.ArrayOrListOfSeqExpr (range=m)
-        | SynExpr.Lambda (range=m)
-        | SynExpr.Match (range=m)
-        | SynExpr.MatchLambda (range=m)
-        | SynExpr.Do (range=m)
-        | SynExpr.Assert (range=m)
-        | SynExpr.App (range=m)
-        | SynExpr.TypeApp (range=m)
-        | SynExpr.LetOrUse (range=m)
-        | SynExpr.TryWith (range=m)
-        | SynExpr.TryFinally (range=m)
-        | SynExpr.Sequential (range=m)
-        | SynExpr.ArbitraryAfterError (range=m)
-        | SynExpr.FromParseError (range=m)
-        | SynExpr.IfThenElse (range=m)
-        | SynExpr.LongIdentSet (range=m)
-        | SynExpr.NamedIndexedPropertySet (range=m)
-        | SynExpr.DotIndexedGet (range=m)
-        | SynExpr.DotIndexedSet (range=m)
-        | SynExpr.DotSet (range=m)
-        | SynExpr.Set (range=m)
-        | SynExpr.DotNamedIndexedPropertySet (range=m)
-        | SynExpr.LibraryOnlyUnionCaseFieldGet (range=m)
-        | SynExpr.LibraryOnlyUnionCaseFieldSet (range=m)
-        | SynExpr.LibraryOnlyILAssembly (range=m)
-        | SynExpr.LibraryOnlyStaticOptimization (range=m)
-        | SynExpr.TypeTest (range=m)
-        | SynExpr.Upcast (range=m)
-        | SynExpr.AddressOf (range=m)
-        | SynExpr.Downcast (range=m)
-        | SynExpr.JoinIn (range=m)
-        | SynExpr.InferredUpcast (range=m)
-        | SynExpr.InferredDowncast (range=m)
-        | SynExpr.Null (range=m)
-        | SynExpr.Lazy (range=m)
-        | SynExpr.TraitCall (range=m)
-        | SynExpr.ImplicitZero (range=m)
-        | SynExpr.YieldOrReturn (range=m)
-        | SynExpr.YieldOrReturnFrom (range=m)
-        | SynExpr.LetOrUseBang (range=m)
-        | SynExpr.MatchBang (range=m)
-        | SynExpr.DoBang (range=m) -> m
         | SynExpr.DotGet (expr, _, lidwd, m) -> if lidwd.ThereIsAnExtraDotAtTheEnd then unionRanges expr.Range lidwd.RangeSansAnyExtraDot else m
         | SynExpr.LongIdent (_, lidwd, _, _) -> lidwd.RangeSansAnyExtraDot
         | SynExpr.DiscardAfterMissingQualificationAfterDot (expr, _) -> expr.Range
-        | SynExpr.Fixed (_, m) -> m
-        | SynExpr.Ident id -> id.idRange
+        | _ -> e.Range
 
     /// Attempt to get the range of the first token or initial portion only - this is extremely ad-hoc, just a cheap way to improve a certain 'query custom operation' error range
     member e.RangeOfFirstPortion =
         match e with
-        // haven't bothered making these cases better than just .Range
-        | SynExpr.Quote (range=m)
-        | SynExpr.Const (range=m)
-        | SynExpr.Typed (range=m)
-        | SynExpr.Tuple (range=m)
-        | SynExpr.ArrayOrList (range=m)
-        | SynExpr.AnonRecd (range=m)
-        | SynExpr.Record (range=m)
-        | SynExpr.New (range=m)
-        | SynExpr.ObjExpr (range=m)
-        | SynExpr.While (range=m)
-        | SynExpr.For (range=m)
-        | SynExpr.CompExpr (range=m)
-        | SynExpr.ArrayOrListOfSeqExpr (range=m)
-        | SynExpr.Lambda (range=m)
-        | SynExpr.Match (range=m)
-        | SynExpr.MatchLambda (range=m)
-        | SynExpr.Do (range=m)
-        | SynExpr.Assert (range=m)
-        | SynExpr.TypeApp (range=m)
-        | SynExpr.LetOrUse (range=m)
-        | SynExpr.TryWith (range=m)
-        | SynExpr.TryFinally (range=m)
-        | SynExpr.ArbitraryAfterError (range=m)
-        | SynExpr.FromParseError (range=m)
-        | SynExpr.DiscardAfterMissingQualificationAfterDot (range=m)
-        | SynExpr.IfThenElse (range=m)
-        | SynExpr.LongIdent (range=m)
-        | SynExpr.LongIdentSet (range=m)
-        | SynExpr.NamedIndexedPropertySet (range=m)
-        | SynExpr.DotIndexedGet (range=m)
-        | SynExpr.DotIndexedSet (range=m)
-        | SynExpr.DotGet (range=m)
-        | SynExpr.DotSet (range=m)
-        | SynExpr.Set (range=m)
-        | SynExpr.DotNamedIndexedPropertySet (range=m)
-        | SynExpr.LibraryOnlyUnionCaseFieldGet (range=m)
-        | SynExpr.LibraryOnlyUnionCaseFieldSet (range=m)
-        | SynExpr.LibraryOnlyILAssembly (range=m)
-        | SynExpr.LibraryOnlyStaticOptimization (range=m)
-        | SynExpr.TypeTest (range=m)
-        | SynExpr.Upcast (range=m)
-        | SynExpr.AddressOf (range=m)
-        | SynExpr.Downcast (range=m)
-        | SynExpr.JoinIn (range=m)
-        | SynExpr.InferredUpcast (range=m)
-        | SynExpr.InferredDowncast (range=m)
-        | SynExpr.Null (range=m)
-        | SynExpr.Lazy (range=m)
-        | SynExpr.TraitCall (range=m)
-        | SynExpr.ImplicitZero (range=m)
-        | SynExpr.YieldOrReturn (range=m)
-        | SynExpr.YieldOrReturnFrom (range=m)
-        | SynExpr.LetOrUseBang (range=m)
-        | SynExpr.MatchBang (range=m)
-        | SynExpr.DoBang (range=m)  -> m
         // these are better than just .Range, and also commonly applicable inside queries
         | SynExpr.Paren (_, m, _, _) -> m
         | SynExpr.Sequential (_, _, e1, _, _)
+        | SynExpr.SequentialOrImplicitYield (_, e1, _, _, _)
         | SynExpr.App (_, _, e1, _, _) ->
             e1.RangeOfFirstPortion
         | SynExpr.ForEach (_, _, _, pat, _, _, r) ->
             let start = r.Start
             let e = (pat.Range: range).Start
             mkRange r.FileName start e
-        | SynExpr.Ident id -> id.idRange
-        | SynExpr.Fixed (_, m) -> m
+        | _ -> e.Range
 
 and
     [<NoEquality; NoComparison; RequireQualifiedAccess>]
@@ -2614,6 +2504,8 @@ let rec synExprContainsError inpExpr =
               walkExpr e1 || walkExpr e2
           | SynExpr.Sequential (_, _, e1, e2, _) ->
               walkExpr e1 || walkExpr e2
+          | SynExpr.SequentialOrImplicitYield (_, e1, e2, _, _) ->
+              walkExpr e1 || walkExpr e2
           | SynExpr.IfThenElse (e1, e2, e3opt, _, _, _, _) ->
               walkExpr e1 || walkExpr e2 || walkExprOpt e3opt
           | SynExpr.DotIndexedGet (e1, es, _, _) ->

src/fsharp/service/ServiceParseTreeWalk.fs

@@ -412,6 +412,7 @@ module public AstTraversal =
                      dive synExpr2 synExpr2.Range traverseSynExpr]
                     |> pick expr
                 | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr
+                | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSeq, synExpr, synExpr2, _, _range) 
                 | SynExpr.Sequential (_sequencePointInfoForSeq, _, synExpr, synExpr2, _range) -> 
                     [dive synExpr synExpr.Range traverseSynExpr
                      dive synExpr2 synExpr2.Range traverseSynExpr]

src/fsharp/service/ServiceUntypedParse.fs

@@ -299,6 +299,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op
                       yield! walkTrySeqPt spTry
                       yield! walkFinallySeqPt spFinally
 
+                  | SynExpr.SequentialOrImplicitYield (spSeq, e1, e2, _, _)
                   | SynExpr.Sequential (spSeq, _, e1, e2, _) -> 
                       yield! walkExpr (match spSeq with SuppressSequencePointOnStmtOfSequential -> false | _ -> true) e1
                       yield! walkExpr (match spSeq with SuppressSequencePointOnExprOfSequential -> false | _ -> true) e2

src/fsharp/xlf/FSComp.txt.cs.xlf

@@ -2817,11 +2817,6 @@
         <target state="translated">Neplatný objektový výraz. U objektů bez přepsání nebo rozhraní by se měl výraz formulovat pomocí notace new Type(args) bez složených závorek.</target>
         <note />
       </trans-unit>
-      <trans-unit id="tcInvalidObjectSequenceOrRecordExpression">
-        <source>Invalid object, sequence or record expression</source>
-        <target state="translated">Neplatný výraz objektu, pořadí nebo záznamu</target>
-        <note />
-      </trans-unit>
       <trans-unit id="tcInvalidSequenceExpressionSyntaxForm">
         <source>Invalid record, sequence or computation expression. Sequence expressions should be of the form 'seq {{ ... }}'</source>
         <target state="translated">Neplatný výraz záznamu, pořadí nebo výpočtu. Výrazy pořadí by měly mít notaci seq {{ ... }}.</target>

src/fsharp/xlf/FSComp.txt.de.xlf

@@ -2817,11 +2817,6 @@
         <target state="translated">Ungültiger Objektausdruck. Objekte ohne Überschreibungen oder Schnittstellen sollten das Ausdrucksformat "new Type(args)" ohne geschweifte Klammern verwenden.</target>
         <note />
       </trans-unit>
-      <trans-unit id="tcInvalidObjectSequenceOrRecordExpression">
-        <source>Invalid object, sequence or record expression</source>
-        <target state="translated">Ungültiger Objekt-, Sequenz- oder Datensatzausdruck.</target>
-        <note />
-      </trans-unit>
       <trans-unit id="tcInvalidSequenceExpressionSyntaxForm">
         <source>Invalid record, sequence or computation expression. Sequence expressions should be of the form 'seq {{ ... }}'</source>
         <target state="translated">Ungültiger Datensatz-, Sequenz- oder Berechnungsausdruck. Sequenzausdrücke müssen das Format "seq {{ ... }}" besitzen.</target>