[FS-1047] - match! (match-bang) (#4427)

* Attempt add match! syntax to parser (as normal match) (does not work)

* Add name for MATCH_BANG token ("keyword 'match!')

* Make match! valid in (and only in) computational expressions

* match! works

* Add match! to xlf localization files

* Add two tests for match!

* Don't use left-pipe

* Give match! keyword a description

* Fix syntax error, and change match! description

* xlf updated

* Add match! keyword description to resx

* Update FSComp.fs

* Write quotation test for match!

* First crack at compile error tests

* Fix baselines

* Fix baseline one more time

* Add vs baseline

* Fix merge mistake

* Fix merge mistake (#2)

* Fix merge mistake in tests

src/buildfromsource/FSharp.Compiler.Private/FSComp.resx

@@ -4152,6 +4152,9 @@
   <data name="keywordDescriptionMatch" xml:space="preserve">
     <value>Used to branch by comparing a value to a pattern.</value>
   </data>
+  <data name="keywordDescriptionMatchBang" xml:space="preserve">
+    <value>Used in computation expressions to pattern match directly over the result of another computation expression.</value>
+  </data>
   <data name="keywordDescriptionMember" xml:space="preserve">
     <value>Used to declare a property or method in an object type.</value>
   </data>

src/fsharp/CompileOps.fs

@@ -1031,6 +1031,7 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) =
               | Parser.TOKEN_LAZY   -> getErrorString("Parser.TOKEN.LAZY")
               | Parser.TOKEN_OLAZY   -> getErrorString("Parser.TOKEN.LAZY")
               | Parser.TOKEN_MATCH   -> getErrorString("Parser.TOKEN.MATCH")
+              | Parser.TOKEN_MATCH_BANG -> getErrorString("Parser.TOKEN.MATCH.BANG")
               | Parser.TOKEN_MUTABLE   -> getErrorString("Parser.TOKEN.MUTABLE")
               | Parser.TOKEN_NEW   -> getErrorString("Parser.TOKEN.NEW")
               | Parser.TOKEN_OF    -> getErrorString("Parser.TOKEN.OF")

src/fsharp/FSComp.txt

@@ -1372,6 +1372,7 @@ keywordDescriptionLazy,"Used to specify a computation that is to be performed on
 keywordDescriptionLet,"Used to associate, or bind, a name to a value or function."
 keywordDescriptionLetBang,"Used in asynchronous workflows to bind a name to the result of an asynchronous computation, or, in other computation expressions, used to bind a name to a result, which is of the computation type."
 keywordDescriptionMatch,"Used to branch by comparing a value to a pattern."
+keywordDescriptionMatchBang,"Used in computation expressions to pattern match directly over the result of another computation expression."
 keywordDescriptionMember,"Used to declare a property or method in an object type."
 keywordDescriptionModule,"Used to associate a name with a group of related types, values, and functions, to logically separate it from other code."
 keywordDescriptionMutable,"Used to declare a variable, that is, a value that can be changed."

src/fsharp/FSStrings.resx

@@ -594,6 +594,9 @@
   <data name="Parser.TOKEN.MATCH" xml:space="preserve">
     <value>keyword 'match'</value>
   </data>
+  <data name="Parser.TOKEN.MATCH.BANG" xml:space="preserve">
+    <value>keyword 'match!'</value>
+  </data>
   <data name="Parser.TOKEN.MUTABLE" xml:space="preserve">
     <value>keyword 'mutable'</value>
   </data>

src/fsharp/LexFilter.fs

@@ -1051,7 +1051,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
             | Parser.EOF _ -> false
             | _ -> 
                 not (isSameLine()) ||  
-                (match peekNextToken() with TRY | MATCH | IF | LET _ | FOR | WHILE -> true | _ -> false) 
+                (match peekNextToken() with TRY | MATCH | MATCH_BANG | IF | LET _ | FOR | WHILE -> true | _ -> false) 
 
         // Look for '=' or '.Id.id.id = ' after an identifier
         let rec isLongIdentEquals token = 
@@ -2034,7 +2034,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
             pushCtxt tokenTup (CtxtIf (tokenStartPos))
             returnToken tokenLexbufState token
 
-        | MATCH, _   -> 
+        | (MATCH | MATCH_BANG), _   -> 
             if debug then dprintf "MATCH, pushing CtxtMatch(%a)\n" outputPos tokenStartPos
             pushCtxt tokenTup (CtxtMatch (tokenStartPos))
             returnToken tokenLexbufState token

src/fsharp/TypeChecker.fs

@@ -3457,7 +3457,8 @@ let (|SimpleSemicolonSequence|_|) acceptDeprecated c =
         | SynExpr.Sequential (_, _, e1, e2, _) -> YieldFree e1 && YieldFree e2
         | SynExpr.IfThenElse (_, e2, e3opt, _, _, _, _) -> YieldFree e2 && Option.forall YieldFree e3opt
         | SynExpr.TryWith (e1, _, clauses, _, _, _, _) -> YieldFree e1 && clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e)
-        | SynExpr.Match (_, _, clauses, _, _) -> clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e)
+        | (SynExpr.Match (_, _, clauses, _, _) | SynExpr.MatchBang (_, _, clauses, _, _)) ->
+            clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e)
         | SynExpr.For (_, _, _, _, _, body, _) 
         | SynExpr.TryFinally (body, _, _, _, _)
         | SynExpr.LetOrUse (_, _, _, body, _) 
@@ -3483,6 +3484,7 @@ let (|SimpleSemicolonSequence|_|) acceptDeprecated c =
         | SynExpr.YieldOrReturn _ 
         | SynExpr.LetOrUse _ 
         | SynExpr.Do _ 
+        | SynExpr.MatchBang _ 
         | SynExpr.LetOrUseBang _ 
         | SynExpr.ImplicitZero _ 
         | SynExpr.While _ -> false
@@ -6040,17 +6042,19 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) =
 
     | SynExpr.YieldOrReturn ((isTrueYield, _), _, m)
     | SynExpr.YieldOrReturnFrom ((isTrueYield, _), _, m) when isTrueYield -> 
-         error(Error(FSComp.SR.tcConstructRequiresListArrayOrSequence(), m))
+        error(Error(FSComp.SR.tcConstructRequiresListArrayOrSequence(), m))
     | SynExpr.YieldOrReturn ((_, isTrueReturn), _, m)
     | SynExpr.YieldOrReturnFrom ((_, isTrueReturn), _, m) when isTrueReturn -> 
-         error(Error(FSComp.SR.tcConstructRequiresComputationExpressions(), m))
+        error(Error(FSComp.SR.tcConstructRequiresComputationExpressions(), m))
     | SynExpr.YieldOrReturn (_, _, m)
     | SynExpr.YieldOrReturnFrom (_, _, m) 
     | SynExpr.ImplicitZero m ->
-         error(Error(FSComp.SR.tcConstructRequiresSequenceOrComputations(), m))
+        error(Error(FSComp.SR.tcConstructRequiresSequenceOrComputations(), m))
     | SynExpr.DoBang  (_, m) 
     | SynExpr.LetOrUseBang  (_, _, _, _, _, _, m) -> 
-         error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m))
+        error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m))
+    | SynExpr.MatchBang (_, _, _, _, m) ->
+        error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m))
 
 /// Check lambdas as a group, to catch duplicate names in patterns
 and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = 
@@ -7960,6 +7964,15 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv
             let clauses = clauses |> List.map (fun (Clause(pat, cond, innerComp, patm, sp)) -> Clause(pat, cond, transNoQueryOps innerComp, patm, sp))
             Some(translatedCtxt (SynExpr.Match(spMatch, expr, clauses, false, m)))
 
+        // 'match! expr with pats ...' --> build.Bind(e1, (function pats ...))
+        | SynExpr.MatchBang (spMatch, expr, clauses, false, m) ->
+            let mMatch = match spMatch with SequencePointAtBinding mMatch -> mMatch | _ -> m
+            if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(), mMatch))
+            if isNil (TryFindIntrinsicOrExtensionMethInfo 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)
+            Some(translatedCtxt (mkSynCall "Bind" mMatch [expr; consumeExpr]))
+
         | SynExpr.TryWith (innerComp, _mTryToWith, clauses, _mWithToLast, mTryToLast, spTry, _spWith) ->
             let mTry = match spTry with SequencePointAtTry(m) -> m | _ -> mTryToLast
 
@@ -8766,6 +8779,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del
             | SynExpr.ImplicitZero  _
             | SynExpr.YieldOrReturn _
             | SynExpr.YieldOrReturnFrom _
+            | SynExpr.MatchBang _
             | SynExpr.LetOrUseBang _
             | SynExpr.DoBang _ 
             | SynExpr.TraitCall _ 

src/fsharp/ast.fs

@@ -692,6 +692,9 @@ and
     /// Computation expressions only
     | LetOrUseBang    of bindSeqPoint:SequencePointInfoForBinding * isUse:bool * isFromSource:bool * SynPat * SynExpr * SynExpr * range:range
 
+    /// F# syntax: match! expr with pat1 -> expr | ... | patN -> exprN
+    | MatchBang of  matchSeqPoint:SequencePointInfoForBinding * expr:SynExpr * clauses:SynMatchClause list * isExnMatch:bool * range:range (* bool indicates if this is an exception match in a computation expression which throws unmatched exceptions *)
+
     /// F# syntax: do! expr
     /// Computation expressions only
     | DoBang      of expr:SynExpr * range:range
@@ -779,6 +782,7 @@ and
         | SynExpr.YieldOrReturn (range=m)
         | SynExpr.YieldOrReturnFrom (range=m)
         | SynExpr.LetOrUseBang (range=m)
+        | SynExpr.MatchBang (range=m)
         | SynExpr.DoBang (range=m)
         | SynExpr.Fixed (range=m) -> m
         | SynExpr.Ident id -> id.idRange
@@ -839,6 +843,7 @@ and
         | 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
@@ -901,6 +906,7 @@ and
         | 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
@@ -2397,6 +2403,8 @@ let rec synExprContainsError inpExpr =
           | SynExpr.DotNamedIndexedPropertySet (e1,_,e2,e3,_) ->
               walkExpr e1 || walkExpr e2 || walkExpr e3
 
+          | SynExpr.MatchBang (_,e,cl,_,_) ->
+              walkExpr e || walkMatchClauses cl
           | SynExpr.LetOrUseBang  (_,_,_,_,e1,e2,_) ->
               walkExpr e1 || walkExpr e2
     walkExpr inpExpr

src/fsharp/lex.fsl

@@ -238,6 +238,8 @@ rule token args skip = parse
      { YIELD_BANG(true)  } 
  | "return!" 
      { YIELD_BANG(false) } 
+ | "match!"
+     { MATCH_BANG }
  | ident '!' 
      { let tok = Keywords.KeywordOrIdentifierToken args lexbuf (lexemeTrimRight lexbuf 1) 
        match tok with 

src/fsharp/lexhelp.fs

@@ -394,6 +394,7 @@ module Keywords =
           "let",       FSComp.SR.keywordDescriptionLet()
           "let!",      FSComp.SR.keywordDescriptionLetBang()
           "match",     FSComp.SR.keywordDescriptionMatch()
+          "match!",    FSComp.SR.keywordDescriptionMatchBang()
           "member",    FSComp.SR.keywordDescriptionMember()
           "module",    FSComp.SR.keywordDescriptionModule()
           "mutable",   FSComp.SR.keywordDescriptionMutable()

src/fsharp/pars.fsy

@@ -193,7 +193,7 @@ let rangeOfLongIdent(lid:LongIdent) =
 %token BAR_BAR UPCAST DOWNCAST NULL RESERVED MODULE NAMESPACE DELEGATE CONSTRAINT BASE
 %token AND AS ASSERT OASSERT ASR BEGIN DO DONE DOWNTO ELSE ELIF END DOT_DOT
 %token EXCEPTION FALSE FOR FUN FUNCTION IF IN JOIN_IN FINALLY DO_BANG 
-%token LAZY OLAZY  MATCH MUTABLE NEW OF 
+%token LAZY OLAZY  MATCH MATCH_BANG  MUTABLE NEW OF 
 %token OPEN OR REC THEN TO TRUE TRY TYPE VAL INLINE INTERFACE INSTANCE CONST
 %token WHEN WHILE WITH HASH AMP AMP_AMP QUOTE LPAREN RPAREN RPAREN_COMING_SOON RPAREN_IS_HERE STAR COMMA RARROW GREATER_BAR_RBRACK LPAREN_STAR_RPAREN
 %token QMARK QMARK_QMARK DOT COLON COLON_COLON COLON_GREATER  COLON_QMARK_GREATER COLON_QMARK COLON_EQUALS SEMICOLON 
@@ -3050,6 +3050,17 @@ declExpr:
       { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileMatch())
         // Produce approximate expression during error recovery 
         exprFromParseError $2 }
+
+  | MATCH_BANG typedSeqExpr     withClauses              %prec expr_match 
+      { let mMatch = (rhs parseState 1)
+        let mWith,(clauses,mLast) = $3 
+        let spBind = SequencePointAtBinding(unionRanges mMatch mWith) 
+        SynExpr.MatchBang(spBind, $2,clauses,false,unionRanges mMatch mLast) }
+
+  | MATCH_BANG typedSeqExpr     recover               %prec expr_match 
+      { if not $3 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedEndOfFileMatch())
+        // Produce approximate expression during error recovery 
+        exprFromParseError $2 }
 
   | TRY typedSeqExprBlockR withClauses              %prec expr_try 
       { let mTry = (rhs parseState 1)

src/fsharp/service/ServiceLexing.fs

@@ -259,7 +259,7 @@ module internal TokenClassifications =
         | ELIF | RARROW | LARROW | SIG | STRUCT 
         | UPCAST   | DOWNCAST   | NULL   | RESERVED    | MODULE    | AND    | AS   | ASSERT   | ASR
         | DOWNTO   | EXCEPTION   | FALSE   | FOR   | FUN   | FUNCTION
-        | FINALLY   | LAZY   | MATCH  | MUTABLE   | NEW   | OF    | OPEN   | OR | VOID | EXTERN
+        | 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
         | HIGH_PRECEDENCE_PAREN_APP | FIXED

src/fsharp/service/ServiceParseTreeWalk.fs

@@ -440,6 +440,10 @@ module public AstTraversal =
                      dive synExpr synExpr.Range traverseSynExpr
                      dive synExpr2 synExpr2.Range traverseSynExpr]
                     |> pick expr
+                | SynExpr.MatchBang(_sequencePointInfoForBinding, synExpr, synMatchClauseList, _, _range) -> 
+                    [yield dive synExpr synExpr.Range traverseSynExpr
+                     yield! synMatchClauseList |> List.map (fun x -> dive x x.RangeOfGuardAndRhs (traverseSynMatchClause path))]
+                    |> pick expr
                 | SynExpr.DoBang(synExpr, _range) -> traverseSynExpr synExpr
                 | SynExpr.LibraryOnlyILAssembly _ -> None
                 | SynExpr.LibraryOnlyStaticOptimization _ -> None

src/fsharp/service/ServiceUntypedParse.fs

@@ -314,7 +314,14 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op
                   | SynExpr.LetOrUseBang  (spBind,_,_,_,e1,e2,_) -> 
                       yield! walkBindSeqPt spBind
                       yield! walkExpr true e1
-                      yield! walkExpr true e2 ]
+                      yield! walkExpr true e2
+
+                  | SynExpr.MatchBang (spBind,e,cl,_,_) ->
+                      yield! walkBindSeqPt spBind
+                      yield! walkExpr false e 
+                      for (Clause(_,whenExpr,e,_,_)) in cl do 
+                          yield! walkExprOpt false whenExpr
+                          yield! walkExpr true e ]
 
             // Process a class declaration or F# type declaration
             let rec walkTycon (TypeDefn(ComponentInfo(_, _, _, _, _, _, _, _), repr, membDefns, m)) =
@@ -849,6 +856,8 @@ module UntypedParseImpl =
             | SynExpr.JoinIn(e1, _, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2]
             | SynExpr.YieldOrReturn(_, e, _) -> walkExprWithKind parentKind e
             | SynExpr.YieldOrReturnFrom(_, e, _) -> walkExprWithKind parentKind e
+            | (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.DoBang(e, _) -> walkExprWithKind parentKind e
             | SynExpr.TraitCall (ts, sign, e, _) ->

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

@@ -6982,6 +6982,11 @@
         <target state="translated">Tento výraz vrátí hodnotu typu {0}, ale implicitně se zahodí. Zvažte vytvoření vazby mezi výsledkem a názvem pomocí klíčového slova let, např. let výsledek = výraz. Pokud jste chtěli výraz použít jako hodnotu v sekvenci, použijte explicitní klíčové slovo yield!.</target>
         <note />
       </trans-unit>
+      <trans-unit id="keywordDescriptionMatchBang">
+        <source>Used in computation expressions to pattern match directly over the result of another computation expression.</source>
+        <target state="new">Used in computation expressions to pattern match directly over the result of another computation expression.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="ilreadFileChanged">
         <source>The file '{0}' changed on disk unexpectedly, please reload.</source>
         <target state="translated">Soubor {0} se na disku neočekávaně změnil, opakujte prosím načtení.</target>

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

@@ -6982,6 +6982,11 @@
         <target state="translated">Dieser Ausdruck gibt einen Wert des Typs "{0}" zurück, wird aber implizit verworfen. Verwenden Sie ggf. "let", um das Ergebnis an einen Namen zu binden. Beispiel: "let Ergebnis = Ausdruck". Falls Sie den Ausdruck als Wert in der Sequenz einsetzen möchten, verwenden Sie explizit "yield!".</target>
         <note />
       </trans-unit>
+      <trans-unit id="keywordDescriptionMatchBang">
+        <source>Used in computation expressions to pattern match directly over the result of another computation expression.</source>
+        <target state="new">Used in computation expressions to pattern match directly over the result of another computation expression.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="ilreadFileChanged">
         <source>The file '{0}' changed on disk unexpectedly, please reload.</source>
         <target state="translated">Die Datei "{0}" wurde auf dem Datenträger unerwartet geändert. Laden Sie sie erneut.</target>

src/fsharp/xlf/FSComp.txt.en.xlf

@@ -6982,6 +6982,11 @@
         <target state="new">This expression returns a value of type '{0}' but is implicitly discarded. Consider using 'let' to bind the result to a name, e.g. 'let result = expression'. If you intended to use the expression as a value in the sequence then use an explicit 'yield!'.</target>
         <note />
       </trans-unit>
+      <trans-unit id="keywordDescriptionMatchBang">
+        <source>Used in computation expressions to pattern match directly over the result of another computation expression.</source>
+        <target state="new">Used in computation expressions to pattern match directly over the result of another computation expression.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="ilreadFileChanged">
         <source>The file '{0}' changed on disk unexpectedly, please reload.</source>
         <target state="new">The file '{0}' changed on disk unexpectedly, please reload.</target>

src/fsharp/xlf/FSComp.txt.es.xlf

@@ -6982,6 +6982,11 @@
         <target state="translated">Esta expresión devuelve un valor de tipo “{0}”, pero se descarta de forma implícita. Considere el uso de “let” para enlazar el resultado a un nombre; por ejemplo, “let result = expression”. Si su intención es utilizar la expresión como un valor en la secuencia, utilice “yield” de forma explícita.</target>
         <note />
       </trans-unit>
+      <trans-unit id="keywordDescriptionMatchBang">
+        <source>Used in computation expressions to pattern match directly over the result of another computation expression.</source>
+        <target state="new">Used in computation expressions to pattern match directly over the result of another computation expression.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="ilreadFileChanged">
         <source>The file '{0}' changed on disk unexpectedly, please reload.</source>
         <target state="translated">El archivo "{0}" cambió en el disco de manera inesperada; cárguelo de nuevo.</target>