Add while! (while bang)

src/Compiler/Checking/CheckComputationExpressions.fs

@@ -111,6 +111,7 @@ let YieldFree (cenv: cenv) expr =
             | SynExpr.TryFinally (tryExpr=body)
             | SynExpr.LetOrUse (body=body)
             | SynExpr.While (doExpr=body)
+            | SynExpr.WhileBang (doExpr=body)
             | SynExpr.ForEach (bodyExpr=body) ->
                 YieldFree body
 
@@ -142,6 +143,7 @@ let YieldFree (cenv: cenv) expr =
             | SynExpr.TryFinally (tryExpr=body)
             | SynExpr.LetOrUse (body=body)
             | SynExpr.While (doExpr=body)
+            | SynExpr.WhileBang (doExpr=body)
             | SynExpr.ForEach (bodyExpr=body) ->
                 YieldFree body
 
@@ -177,7 +179,8 @@ let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr =
         | SynExpr.Do _ 
         | SynExpr.MatchBang _ 
         | SynExpr.LetOrUseBang _ 
-        | SynExpr.While _ -> false
+        | SynExpr.While _
+        | SynExpr.WhileBang _ -> false
         | _ -> true
 
     let rec TryGetSimpleSemicolonSequenceOfComprehension expr acc = 
@@ -1027,6 +1030,36 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
                         [ mkSynDelay2 guardExpr; 
                           mkSynCall "Delay" mWhile [mkSynDelay innerComp.Range holeFill]])) )
 
+        | SynExpr.WhileBang (spWhile, guardExpr, innerComp, mOrig) -> 
+            let mGuard = guardExpr.Range
+            let mWhile = match spWhile with DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) | _ -> mGuard
+            let mGuard = mGuard.MakeSynthetic()
+
+            // 'while!' is hit just before each time the guard is called
+            let guardExpr = 
+                match spWhile with
+                | DebugPointAtWhile.Yes _ ->
+                    SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr)
+                | DebugPointAtWhile.No -> guardExpr
+
+            let rewrittenWhileExpr =
+                let idFirst = mkSynId mGuard (CompilerGeneratedName "first")
+                let patFirst = mkSynPatVar None idFirst
+
+                let body =
+                    let idCond = mkSynId mGuard (CompilerGeneratedName "cond")
+                    let patCond = mkSynPatVar None idCond
+                    let condBinding = mkSynBinding (Xml.PreXmlDoc.Empty, patCond) (None, false, true, mGuard, DebugPointAtBinding.NoneAtSticky, None, SynExpr.Ident idFirst, mGuard, [], [], None, SynBindingTrivia.Zero)  
+                    let setCondExpr = SynExpr.Set (SynExpr.Ident idCond, SynExpr.Ident idFirst, mGuard)
+                    let bindCondExpr = SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtSticky, false, true, patFirst, guardExpr, [], setCondExpr, mGuard, SynExprLetOrUseBangTrivia.Zero)
+
+                    let whileExpr = SynExpr.While (DebugPointAtWhile.No, SynExpr.Ident idCond, SynExpr.Sequential (DebugPointAtSequential.SuppressBoth, true, innerComp, bindCondExpr, mWhile), mOrig)
+                    SynExpr.LetOrUse (false, false, [ condBinding ], whileExpr, mGuard, SynExprLetOrUseTrivia.Zero)
+
+                SynExpr.LetOrUseBang (DebugPointAtBinding.NoneAtSticky, false, true, patFirst, guardExpr, [], body, mGuard, SynExprLetOrUseBangTrivia.Zero)
+
+            tryTrans CompExprTranslationPass.Initial q varSpace rewrittenWhileExpr translatedCtxt
+
         | SynExpr.TryFinally (innerComp, unwindExpr, _mTryToLast, spTry, spFinally, trivia) ->
 
             let mTry = match spTry with DebugPointAtTry.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Try) | _ -> trivia.TryKeyword
@@ -1737,14 +1770,15 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
 
         | _ -> None
 
-    /// Check is an expression has no computation expression constructs
+    /// Check if an expression has no computation expression constructs
     and isSimpleExpr comp =
 
         match comp with 
         | ForEachThenJoinOrGroupJoinOrZipClause false _ -> false
         | SynExpr.ForEach _ -> false
         | SynExpr.For _ -> false
         | SynExpr.While _ -> false
+        | SynExpr.WhileBang _ -> false
         | SynExpr.TryFinally _ -> false
         | SynExpr.ImplicitZero _ -> false
         | OptionalSequential (JoinOrGroupJoinOrZipClause _, _) -> false

src/Compiler/Checking/CheckExpressions.fs

@@ -5745,10 +5745,9 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
         error(Error(FSComp.SR.tcConstructRequiresSequenceOrComputations(), m))
 
     | SynExpr.DoBang (_, m)
-    | SynExpr.LetOrUseBang  (range=m) ->
-        error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m))
-
-    | SynExpr.MatchBang (range=m) ->
+    | SynExpr.MatchBang (range = m)
+    | SynExpr.WhileBang (range = m)
+    | SynExpr.LetOrUseBang (range = m) ->
         error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m))
 
     // Part of 'T.Ident
@@ -8780,6 +8779,7 @@ and TcImplicitOpItemThen (cenv: cenv) overallTy env id sln tpenv mItem delayed =
         | SynExpr.MatchBang _
         | SynExpr.LetOrUseBang _
         | SynExpr.DoBang _
+        | SynExpr.WhileBang _
         | SynExpr.TraitCall _
         | SynExpr.IndexFromEnd _
         | SynExpr.IndexRange _

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -1188,6 +1188,7 @@ type Exception with
                 | Parser.TOKEN_INLINE -> SR.GetString("Parser.TOKEN.INLINE")
                 | Parser.TOKEN_WHEN -> SR.GetString("Parser.TOKEN.WHEN")
                 | Parser.TOKEN_WHILE -> SR.GetString("Parser.TOKEN.WHILE")
+                | Parser.TOKEN_WHILE_BANG -> SR.GetString("Parser.TOKEN.WHILE.BANG")
                 | Parser.TOKEN_WITH -> SR.GetString("Parser.TOKEN.WITH")
                 | Parser.TOKEN_IF -> SR.GetString("Parser.TOKEN.IF")
                 | Parser.TOKEN_DO -> SR.GetString("Parser.TOKEN.DO")

src/Compiler/Driver/GraphChecking/FileContentMapping.fs

@@ -462,6 +462,8 @@ let visitSynExpr (e: SynExpr) : FileContentEntry list =
                 [ yield! exprNodes; yield! List.collect visitSynMatchClause clauses ]
                 |> continuation)
         | SynExpr.DoBang (expr, _) -> visit expr continuation
+        | SynExpr.WhileBang (whileExpr = whileExpr; doExpr = doExpr) ->
+            visit whileExpr (fun whileNodes -> visit doExpr (fun doNodes -> whileNodes @ doNodes |> continuation))
         | SynExpr.LibraryOnlyILAssembly (typeArgs = typeArgs; args = args; retTy = retTy) ->
             let typeNodes = List.collect visitSynType (typeArgs @ retTy)
             let continuations = List.map visit args

src/Compiler/FSComp.txt

@@ -1465,6 +1465,7 @@ keywordDescriptionVal,"Used in a signature to indicate a value, or in a type to
 keywordDescriptionVoid,"Indicates the .NET void type. Used when interoperating with other .NET languages."
 keywordDescriptionWhen,"Used for Boolean conditions (when guards) on pattern matches and to introduce a constraint clause for a generic type parameter."
 keywordDescriptionWhile,"Introduces a looping construct."
+keywordDescriptionWhileBang,"Used in computation expressions to introduce a looping construct where the condition is the result of another computation expression."
 keywordDescriptionWith,"Used together with the match keyword in pattern matching expressions. Also used in object expressions, record copying expressions, and type extensions to introduce member definitions, and to introduce exception handlers."
 keywordDescriptionYield,"Used in a sequence expression to produce a value for a sequence."
 keywordDescriptionYieldBang,"Used in a computation expression to append the result of a given computation expression to a collection of results for the containing computation expression."
@@ -1577,6 +1578,7 @@ featureWarningWhenMultipleRecdTypeChoice,"Raises warnings when multiple record t
 featureImprovedImpliedArgumentNames,"Improved implied argument names"
 featureStrictIndentation,"Raises errors on incorrect indentation, allows better recovery and analysis during editing"
 featureChkNotTailRecursive,"Raises warnings if a member or function has the 'TailCall' attribute, but is not being used in a tail recursive way."
+featureWhileBang,"'while!' expression"
 3353,fsiInvalidDirective,"Invalid directive '#%s %s'"
 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."

src/Compiler/FSStrings.resx

@@ -112,10 +112,10 @@
     <value>2.0</value>
   </resheader>
   <resheader name="reader">
-    <value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+    <value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </resheader>
   <resheader name="writer">
-    <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+    <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </resheader>
   <data name="SeeAlso" xml:space="preserve">
     <value>. See also {0}.</value>
@@ -1113,4 +1113,7 @@
   <data name="ErrorFromAddingTypeEquationTuples" xml:space="preserve">
     <value>Type mismatch. Expecting a tuple of length {0} of type\n    {1}    \nbut given a tuple of length {2} of type\n    {3}    {4}\n</value>
   </data>
+  <data name="Parser.TOKEN.WHILE.BANG" xml:space="preserve">
+    <value>keyword 'while!'</value>
+  </data>
 </root>

src/Compiler/Facilities/LanguageFeatures.fs

@@ -74,6 +74,7 @@ type LanguageFeature =
     | DiagnosticForObjInference
     | StaticLetInRecordsDusEmptyTypes
     | WarningWhenTailRecAttributeButNonTailRecUsage
+    | WhileBang
 
 /// LanguageVersion management
 type LanguageVersion(versionText) =
@@ -171,6 +172,7 @@ type LanguageVersion(versionText) =
                 LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage, previewVersion
                 LanguageFeature.StaticLetInRecordsDusEmptyTypes, previewVersion
                 LanguageFeature.StrictIndentation, previewVersion
+                LanguageFeature.WhileBang, previewVersion
             ]
 
     static let defaultLanguageVersion = LanguageVersion("default")
@@ -300,6 +302,7 @@ type LanguageVersion(versionText) =
         | LanguageFeature.StaticLetInRecordsDusEmptyTypes -> FSComp.SR.featureStaticLetInRecordsDusEmptyTypes ()
         | LanguageFeature.StrictIndentation -> FSComp.SR.featureStrictIndentation ()
         | LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage -> FSComp.SR.featureChkNotTailRecursive ()
+        | LanguageFeature.WhileBang -> FSComp.SR.featureWhileBang ()
 
     /// Get a version string associated with the given feature.
     static member GetFeatureVersionString feature =

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -64,6 +64,7 @@ type LanguageFeature =
     | DiagnosticForObjInference
     | StaticLetInRecordsDusEmptyTypes
     | WarningWhenTailRecAttributeButNonTailRecUsage
+    | WhileBang
 
 /// LanguageVersion management
 type LanguageVersion =

src/Compiler/Service/FSharpParseFileResults.fs

@@ -7,7 +7,6 @@ open System.IO
 open System.Collections.Generic
 open System.Diagnostics
 open Internal.Utilities.Library
-open Internal.Utilities.Library.Extras
 open FSharp.Compiler.Diagnostics
 open FSharp.Compiler.EditorServices
 open FSharp.Compiler.Syntax
@@ -801,7 +800,8 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput,
                             for SynInterfaceImpl (bindings = bs) in is do
                                 yield! walkBinds bs
 
-                        | SynExpr.While (spWhile, e1, e2, _) ->
+                        | SynExpr.While (spWhile, e1, e2, _)
+                        | SynExpr.WhileBang (spWhile, e1, e2, _) ->
                             yield! walkWhileSeqPt spWhile
                             yield! walkExpr false e1
                             yield! walkExpr true e2
@@ -835,7 +835,8 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput,
 
                         | SynExpr.DotLambda (expr = bodyExpr) -> yield! walkExpr true bodyExpr
 
-                        | SynExpr.Match (matchDebugPoint = spBind; expr = inpExpr; clauses = cl) ->
+                        | SynExpr.Match (matchDebugPoint = spBind; expr = inpExpr; clauses = cl)
+                        | SynExpr.MatchBang (matchDebugPoint = spBind; expr = inpExpr; clauses = cl) ->
                             yield! walkBindSeqPt spBind
                             yield! walkExpr false inpExpr
 
@@ -917,14 +918,6 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput,
                                 yield! walkExpr true eAndBang
 
                             yield! walkExpr true bodyExpr
-
-                        | SynExpr.MatchBang (matchDebugPoint = spBind; expr = inpExpr; clauses = clauses) ->
-                            yield! walkBindSeqPt spBind
-                            yield! walkExpr false inpExpr
-
-                            for SynMatchClause (whenExpr = whenExpr; resultExpr = resExpr) in clauses do
-                                yield! walkExprOpt true whenExpr
-                                yield! walkExpr true resExpr
                 ]
 
             // Process a class declaration or F# type declaration

src/Compiler/Service/ServiceLexing.fs

@@ -378,6 +378,7 @@ module internal TokenClassifications =
         | INLINE
         | WHEN
         | WHILE
+        | WHILE_BANG
         | WITH
         | IF
         | THEN
@@ -1362,6 +1363,7 @@ type FSharpTokenKind =
     | ColonEquals
     | When
     | While
+    | WhileBang
     | With
     | Hash
     | Ampersand
@@ -1572,6 +1574,7 @@ type FSharpToken =
         | SEMICOLON -> FSharpTokenKind.SemicolonSemicolon
         | WHEN -> FSharpTokenKind.When
         | WHILE -> FSharpTokenKind.While
+        | WHILE_BANG -> FSharpTokenKind.WhileBang
         | WITH -> FSharpTokenKind.With
         | HASH -> FSharpTokenKind.Hash
         | AMP -> FSharpTokenKind.Ampersand

src/Compiler/Service/ServiceLexing.fsi

@@ -444,6 +444,7 @@ type public FSharpTokenKind =
     | ColonEquals
     | When
     | While
+    | WhileBang
     | With
     | Hash
     | Ampersand

src/Compiler/Service/ServiceParseTreeWalk.fs

@@ -512,7 +512,8 @@ module SyntaxTraversal =
                         ]
                         |> pick expr
 
-                | SynExpr.While (_spWhile, synExpr, synExpr2, _range) ->
+                | SynExpr.While (_spWhile, synExpr, synExpr2, _range)
+                | SynExpr.WhileBang (_spWhile, synExpr, synExpr2, _range) ->
                     [
                         dive synExpr synExpr.Range traverseSynExpr
                         dive synExpr2 synExpr2.Range traverseSynExpr
@@ -568,7 +569,8 @@ module SyntaxTraversal =
                     |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
                     |> pick expr
 
-                | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList) ->
+                | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList)
+                | SynExpr.MatchBang (expr = synExpr; clauses = synMatchClauseList) ->
                     [
                         yield dive synExpr synExpr.Range traverseSynExpr
                         yield!
@@ -577,7 +579,8 @@ module SyntaxTraversal =
                     ]
                     |> pick expr
 
-                | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr
+                | SynExpr.Do (synExpr, _)
+                | SynExpr.DoBang (synExpr, _) -> traverseSynExpr synExpr
 
                 | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr
 
@@ -762,17 +765,6 @@ module SyntaxTraversal =
                     ]
                     |> pick expr
 
-                | SynExpr.MatchBang (expr = synExpr; clauses = synMatchClauseList) ->
-                    [
-                        yield dive synExpr synExpr.Range traverseSynExpr
-                        yield!
-                            synMatchClauseList
-                            |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
-                    ]
-                    |> pick expr
-
-                | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr
-
                 | SynExpr.LibraryOnlyILAssembly _ -> None
 
                 | SynExpr.LibraryOnlyStaticOptimization _ -> None

src/Compiler/Service/ServiceStructure.fs

@@ -431,7 +431,8 @@ module Structure =
                         parseExpr elseExpr
                 | None -> ()
 
-            | SynExpr.While (_, _, e, r) ->
+            | SynExpr.While (_, _, e, r)
+            | SynExpr.WhileBang (_, _, e, r) ->
                 rcheck Scope.While Collapse.Below r r
                 parseExpr e
 

src/Compiler/SyntaxTree/LexFilter.fs

@@ -1272,7 +1272,7 @@ type LexFilterImpl (
             | EOF _ -> false
             | _ ->
                 not (isSameLine()) ||
-                (match peekNextToken() with TRY | MATCH | MATCH_BANG | IF | LET _ | FOR | WHILE -> true | _ -> false)
+                (match peekNextToken() with TRY | MATCH | MATCH_BANG | IF | LET _ | FOR | WHILE | WHILE_BANG -> true | _ -> false)
 
         // Look for '=' or '.Id.id.id = ' after an identifier
         let rec isLongIdentEquals token =
@@ -2370,7 +2370,7 @@ type LexFilterImpl (
             pushCtxt tokenTup (CtxtFor tokenStartPos)
             returnToken tokenLexbufState token
 
-        | WHILE, _ ->
+        | (WHILE | WHILE_BANG), _ ->
             if debug then dprintf "WHILE, pushing CtxtWhile(%a)\n" outputPos tokenStartPos
             pushCtxt tokenTup (CtxtWhile tokenStartPos)
             returnToken tokenLexbufState token

src/Compiler/SyntaxTree/PrettyNaming.fs

@@ -238,6 +238,7 @@ let keywordsWithDescription: (string * string) list =
         "void", FSComp.SR.keywordDescriptionVoid ()
         "when", FSComp.SR.keywordDescriptionWhen ()
         "while", FSComp.SR.keywordDescriptionWhile ()
+        "while!", FSComp.SR.keywordDescriptionWhileBang ()
         "with", FSComp.SR.keywordDescriptionWith ()
         "yield", FSComp.SR.keywordDescriptionYield ()
         "yield!", FSComp.SR.keywordDescriptionYieldBang ()

src/Compiler/SyntaxTree/SyntaxTree.fs

@@ -684,6 +684,8 @@ type SynExpr =
 
     | DoBang of expr: SynExpr * range: range
 
+    | WhileBang of whileDebugPoint: DebugPointAtWhile * whileExpr: SynExpr * doExpr: SynExpr * range: range
+
     | LibraryOnlyILAssembly of
         ilCode: obj *  // this type is ILInstr[]  but is hidden to avoid the representation of AbstractIL being public
         typeArgs: SynType list *
@@ -783,6 +785,7 @@ type SynExpr =
         | SynExpr.LetOrUseBang (range = m)
         | SynExpr.MatchBang (range = m)
         | SynExpr.DoBang (range = m)
+        | SynExpr.WhileBang (range = m)
         | SynExpr.Fixed (range = m)
         | SynExpr.InterpolatedString (range = m)
         | SynExpr.Dynamic (range = m) -> m

src/Compiler/SyntaxTree/SyntaxTree.fsi

@@ -878,6 +878,9 @@ type SynExpr =
     /// Computation expressions only
     | DoBang of expr: SynExpr * range: range
 
+    /// F# syntax: 'while! ... do ...'
+    | WhileBang of whileDebugPoint: DebugPointAtWhile * whileExpr: SynExpr * doExpr: SynExpr * range: range
+
     /// Only used in FSharp.Core
     | LibraryOnlyILAssembly of
         ilCode: obj *  // this type is ILInstr[]  but is hidden to avoid the representation of AbstractIL being public