[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

Author: jwosty

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

@@ -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/buildfromsource/FSharp.Compiler.Private/FSComp.resx

@@ -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/CompileOps.fs

@@ -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/FSComp.txt

@@ -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/FSStrings.resx

@@ -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/LexFilter.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/TypeChecker.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/ast.fs

@@ -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/lex.fsl

@@ -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()