squash and-bang implementation (#7756)

Co-authored-by: Kevin Ransom (msft) <[email protected]>

Author: dsyme

src/fsharp/CompileOps.fs

@@ -1004,6 +1004,8 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa
               | Parser.TOKEN_OLET(_) -> getErrorString("Parser.TOKEN.OLET")
               | Parser.TOKEN_OBINDER 
               | Parser.TOKEN_BINDER -> getErrorString("Parser.TOKEN.BINDER")
+              | Parser.TOKEN_OAND_BANG 
+              | Parser.TOKEN_AND_BANG -> getErrorString("Parser.TOKEN.AND.BANG")
               | Parser.TOKEN_ODO -> getErrorString("Parser.TOKEN.ODO")
               | Parser.TOKEN_OWITH -> getErrorString("Parser.TOKEN.OWITH")
               | Parser.TOKEN_OFUNCTION -> getErrorString("Parser.TOKEN.OFUNCTION")

src/fsharp/FSComp.txt

@@ -1475,6 +1475,9 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl
 3301,chkInvalidFunctionReturnType,"The function or method has an invalid return type '%s'. This is not permitted by the rules of Common IL."
 3302,packageManagementRequiresVFive,"The package management feature requires language version 5.0 use /langversion:preview"
 3303,fromEndSlicingRequiresVFive,"From the end slicing with requires language version 5.0, use /langversion:preview."
+3343,tcRequireMergeSourcesOrBindN,"The 'let! ... and! ...' construct may only be used if the computation expression builder defines either a '%s' method or appropriate 'MergeSource' and 'Bind' methods"
+3344,tcAndBangNotSupported,"This feature is not supported in this version of F#. You may need to add /langversion:preview to use this feature."
+3345,tcInvalidUseBangBindingNoAndBangs,"use! may not be combined with and!"
 useSdkRefs,"Use reference assemblies for .NET framework references when available (Enabled by default)."
 fSharpBannerVersion,"%s for F# %s"
 optsLangVersion,"Display the allowed values for language version, specify language version such as 'latest' or 'preview'"

src/fsharp/FSStrings.resx

@@ -564,6 +564,9 @@
   <data name="Parser.TOKEN.AND" xml:space="preserve">
     <value>keyword 'and'</value>
   </data>
+  !<data name="Parser.TOKEN.AND.BANG" xml:space="preserve">
+    <value>keyword 'and!'</value>
+  </data>
   <data name="Parser.TOKEN.AS" xml:space="preserve">
     <value>keyword 'as'</value>
   </data>

src/fsharp/LanguageFeatures.fs

@@ -28,6 +28,7 @@ type LanguageFeature =
     | PackageManagement
     | FromEndSlicing
     | FixedIndexSlice3d4d
+    | AndBang
 
 /// LanguageVersion management
 type LanguageVersion (specifiedVersionAsString) =
@@ -61,6 +62,7 @@ type LanguageVersion (specifiedVersionAsString) =
             LanguageFeature.NameOf, previewVersion
             LanguageFeature.OpenStaticClasses, previewVersion
             LanguageFeature.PackageManagement, previewVersion
+            LanguageFeature.AndBang, previewVersion
         ]
 
     let specified =

src/fsharp/LanguageFeatures.fsi

@@ -16,7 +16,7 @@ type LanguageFeature =
     | PackageManagement
     | FromEndSlicing
     | FixedIndexSlice3d4d
-
+    | AndBang
 
 /// LanguageVersion management
 type LanguageVersion =

src/fsharp/LexFilter.fs

@@ -1784,6 +1784,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
             pushCtxt tokenTup (CtxtLetDecl(blockLet, tokenStartPos))
             returnToken tokenLexbufState (if blockLet then OBINDER b else token)
 
+        //  and!  ... ~~~> CtxtLetDecl 
+        | AND_BANG isUse, (ctxt :: _) -> 
+            let blockLet = match ctxt with CtxtSeqBlock _ -> true | _ -> false
+            if debug then dprintf "AND!: entering CtxtLetDecl(blockLet=%b), awaiting EQUALS to go to CtxtSeqBlock (%a)\n" blockLet outputPos tokenStartPos
+            pushCtxt tokenTup (CtxtLetDecl(blockLet,tokenStartPos))
+            returnToken tokenLexbufState (if blockLet then OAND_BANG isUse else token)
+
         | (VAL | STATIC | ABSTRACT | MEMBER | OVERRIDE | DEFAULT), ctxtStack when thereIsACtxtMemberBodyOnTheStackAndWeShouldPopStackForUpcomingMember ctxtStack -> 
             if debug then dprintf "STATIC/MEMBER/OVERRIDE/DEFAULT: already inside CtxtMemberBody, popping all that context before starting next member...\n"
             // save this token, we'll consume it again later...

src/fsharp/TypeChecker.fs

@@ -764,12 +764,13 @@ and
     /// Computation expressions only
     | YieldOrReturnFrom of (bool * bool) * expr: SynExpr * range: range
 
-    /// SynExpr.LetOrUseBang (spBind, isUse, isFromSource, pat, rhsExpr, bodyExpr, mWholeExpr).
+    /// SynExpr.LetOrUseAndBang (spBind, isUse, isFromSource, pat, rhsExpr, mLetBangExpr, [(andBangSpBind, andBangIsUse, andBangIsFromSource, andBangPat, andBangRhsExpr, mAndBangExpr)], bodyExpr).
     ///
     /// F# syntax: let! pat = expr in expr
     /// F# syntax: use! pat = expr in expr
+    /// F# syntax: let! pat = expr and! ... and! ... and! pat = expr in expr
     /// Computation expressions only
-    | LetOrUseBang of bindSeqPoint: SequencePointInfoForBinding * isUse: bool * isFromSource: bool * SynPat * SynExpr * SynExpr * range: range
+    | LetOrUseBang of bindSeqPoint: SequencePointInfoForBinding * isUse: bool * isFromSource: bool * SynPat * rhs: SynExpr * andBangs:(SequencePointInfoForBinding * bool * bool * SynPat * SynExpr * range) list * body:SynExpr * range: range 
 
     /// F# syntax: match! expr with pat1 -> expr | ... | patN -> exprN
     | MatchBang of  matchSeqPoint: SequencePointInfoForBinding * expr: SynExpr * clauses: SynMatchClause list * range: range (* bool indicates if this is an exception match in a computation expression which throws unmatched exceptions *)
@@ -2475,6 +2476,6 @@ let rec synExprContainsError inpExpr =
 
           | SynExpr.MatchBang (_, e, cl, _) ->
               walkExpr e || walkMatchClauses cl
-          | SynExpr.LetOrUseBang  (_, _, _, _, e1, e2, _) ->
-              walkExpr e1 || walkExpr e2
+          | SynExpr.LetOrUseBang  (rhs=e1;body=e2;andBangs=es) ->
+              walkExpr e1 || walkExprs [ for (_,_,_,_,e,_) in es do yield e ] || walkExpr e2
     walkExpr inpExpr

src/fsharp/ast.fs

@@ -233,10 +233,12 @@ rule token args skip = parse
      { YIELD_BANG(false) } 
  | "match!"
      { MATCH_BANG }
+ | "and!"
+     { AND_BANG(false) }
  | ident '!' 
      { let tok = Keywords.KeywordOrIdentifierToken args lexbuf (lexemeTrimRight lexbuf 1) 
        match tok with 
-       | LET _ -> BINDER (lexemeTrimRight lexbuf 1) 
+       | LET _ -> BINDER (lexemeTrimRight lexbuf 1)
        | _ -> fail args lexbuf (FSComp.SR.lexIdentEndInMarkReserved("!")) (Keywords.KeywordOrIdentifierToken args lexbuf (lexeme lexbuf)) } 
  | ident ('#')  
      { fail args lexbuf (FSComp.SR.lexIdentEndInMarkReserved("#")) (Keywords.KeywordOrIdentifierToken args lexbuf (lexeme lexbuf)) }

src/fsharp/lex.fsl

@@ -189,7 +189,7 @@ let rangeOfLongIdent(lid:LongIdent) =
 %token <char> CHAR
 %token <System.Decimal> DECIMAL 
 %token <(string * string)> BIGNUM
-%token <bool> LET YIELD YIELD_BANG 
+%token <bool> LET YIELD YIELD_BANG AND_BANG
 %token <bool> LESS GREATER /* here the bool indicates if the tokens are part of a type application or type parameter declaration, e.g. C<int>, detected by the lex filter */
 %token <string> PERCENT_OP BINDER 
 %token <string * bool> LQUOTE RQUOTE  RQUOTE_DOT 
@@ -218,6 +218,7 @@ let rangeOfLongIdent(lid:LongIdent) =
 /* for offside rule */
 %token <bool> OLET      /* LexFilter #light converts 'LET' tokens to 'OLET' when starting (CtxtLetDecl(blockLet=true)) */
 %token <string> OBINDER /* LexFilter #light converts 'BINDER' tokens to 'OBINDER' when starting (CtxtLetDecl(blockLet=true)) */
+%token <bool> OAND_BANG /* LexFilter #light converts 'AND_BANG' tokens to 'OAND_BANG' when starting (CtxtLetDecl(blockLet=true)) */
 %token ODO              /* LexFilter #light converts 'DO' tokens to 'ODO' */
 %token ODO_BANG         /* LexFilter #light converts 'DO_BANG' tokens to 'ODO_BANG' */
 %token OTHEN            /* LexFilter #light converts 'THEN' tokens to 'OTHEN' */
@@ -453,7 +454,8 @@ let rangeOfLongIdent(lid:LongIdent) =
 %nonassoc paren_pat_colon
 %nonassoc paren_pat_attribs
 %left OR BAR_BAR JOIN_IN
-%left AND   /* check */
+%left AND
+%left AND_BANG
 %left  AMP AMP_AMP 
 %nonassoc pat_conj
 %nonassoc expr_not
@@ -3060,6 +3062,20 @@ recover:
    | error { debugPrint("recovering via error"); true }  
    | EOF { debugPrint("recovering via EOF"); false }
 
+morebinders:
+  | AND_BANG headBindingPattern EQUALS typedSeqExprBlock IN morebinders %prec expr_let
+     { let spBind = SequencePointAtBinding(rhs2 parseState 1 5) (* TODO Pretty sure this is wrong *)
+       let m = rhs parseState 1 (* TODO Pretty sure this is wrong *)
+       (spBind,$1,true,$2,$4,m) :: $6 }
+
+  | OAND_BANG headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP morebinders %prec expr_let
+     { $5 "and!" (rhs parseState 1)  // report unterminated error
+       let spBind = SequencePointAtBinding(rhs2 parseState 1 5) (* TODO Pretty sure this is wrong *)
+       let m = rhs parseState 1 (* TODO Pretty sure this is wrong *)
+       (spBind,$1,true,$2,$4,m) :: $7 }
+
+  | %prec prec_no_more_attr_bindings
+      { [] }
 
 declExpr:
   | defnBindings IN typedSeqExpr  %prec expr_let 
@@ -3353,27 +3369,35 @@ declExpr:
   | YIELD_BANG declExpr
      { SynExpr.YieldOrReturnFrom (($1,not $1), $2, unionRanges (rhs parseState 1) $2.Range) } 
 
-  | BINDER headBindingPattern EQUALS typedSeqExprBlock IN opt_OBLOCKSEP typedSeqExprBlock %prec expr_let 
+  | YIELD recover
+     { let mYieldAll = rhs parseState 1
+       SynExpr.YieldOrReturn (($1, not $1), arbExpr("yield", mYieldAll), mYieldAll) } 
+
+  | YIELD_BANG recover
+     { let mYieldAll = rhs parseState 1
+       SynExpr.YieldOrReturnFrom (($1, not $1), arbExpr("yield!", mYieldAll), mYieldAll) } 
+
+  | BINDER headBindingPattern EQUALS typedSeqExprBlock IN opt_OBLOCKSEP morebinders typedSeqExprBlock %prec expr_let
      { let spBind = SequencePointAtBinding(rhs2 parseState 1 5)
-       let m = unionRanges (rhs parseState 1) $7.Range
-       SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4,$7,m) }
+       let m = unionRanges (rhs parseState 1) $8.Range
+       SynExpr.LetOrUseBang(spBind, ($1 = "use"), true, $2, $4, $7, $8, m) }
 
-  | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP typedSeqExprBlock %prec expr_let 
+  | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP morebinders typedSeqExprBlock %prec expr_let
      { $5 (if $1 = "use" then "use!" else "let!") (rhs parseState 1)  // report unterminated error 
        let spBind = SequencePointAtBinding(unionRanges (rhs parseState 1) $4.Range)
-       let m = unionRanges (rhs parseState 1) $7.Range
-       SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4,$7,m) }
+       let m = unionRanges (rhs parseState 1) $8.Range
+       SynExpr.LetOrUseBang(spBind, ($1 = "use"), true, $2, $4, $7, $8, m) }
 
   | OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP error %prec expr_let 
      { // error recovery that allows intellisense when writing incomplete computation expressions 
        let spBind = SequencePointAtBinding(unionRanges (rhs parseState 1) $4.Range) 
        let mAll = unionRanges (rhs parseState 1) (rhs parseState 7)
        let m = $4.Range.EndRange // zero-width range
-       SynExpr.LetOrUseBang (spBind,($1 = "use"),true,$2,$4, SynExpr.ImplicitZero m, mAll) }
+       SynExpr.LetOrUseBang(spBind, ($1 = "use"), true, $2, $4, [], SynExpr.ImplicitZero m, mAll) }
 
   | DO_BANG typedSeqExpr IN opt_OBLOCKSEP typedSeqExprBlock %prec expr_let 
      { let spBind = NoSequencePointAtDoBinding
-       SynExpr.LetOrUseBang (spBind,false,true,SynPat.Const(SynConst.Unit,$2.Range),$2,$5, unionRanges (rhs parseState 1) $5.Range) }
+       SynExpr.LetOrUseBang(spBind, false, true, SynPat.Const(SynConst.Unit,$2.Range), $2, [], $5, unionRanges (rhs parseState 1) $5.Range) }
 
   | ODO_BANG typedSeqExprBlock hardwhiteDefnBindingsTerminator %prec expr_let 
      { SynExpr.DoBang ($2, unionRanges (rhs parseState 1) $2.Range) }