Parser: recover on unfinished do members

src/Compiler/SyntaxTree/LexFilter.fs

@@ -748,6 +748,9 @@ type LexFilterImpl (
             // ignore Vanilla because a SeqBlock is always coming
             | _, CtxtVanilla _ :: rest -> undentationLimit strict rest
 
+            |  CtxtSeqBlock(FirstInSeqBlock, _, _), (CtxtDo _ as limitCtxt) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ | CtxtModuleBody _) :: _ ->
+                PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1)
+
             | _, CtxtSeqBlock _ :: rest when not strict -> undentationLimit strict rest
             | _, CtxtParen _ :: rest when not strict -> undentationLimit strict rest
 
@@ -1587,7 +1590,7 @@ type LexFilterImpl (
                 | _ ->
                     delayToken tokenTup
                     pushCtxt tokenTup (CtxtNamespaceBody namespaceTokenPos)
-                    pushCtxtSeqBlockAt false tokenTup tokenTup AddBlockEnd
+                    pushCtxtSeqBlockAt false false tokenTup tokenTup AddBlockEnd
                     hwTokenFetch false
 
         //  Transition rule. CtxtModuleHead ~~~> push CtxtModuleBody; push CtxtSeqBlock
@@ -2162,7 +2165,7 @@ type LexFilterImpl (
         | (DO | DO_BANG), _ ->
             if debug then dprintf "DO: pushing CtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos
             pushCtxt tokenTup (CtxtDo tokenStartPos)
-            pushCtxtSeqBlock tokenTup AddBlockEnd
+            tryPushCtxtSeqBlock tokenTup AddBlockEnd
             returnToken tokenLexbufState (match token with DO -> ODO | DO_BANG -> ODO_BANG | _ -> failwith "unreachable")
 
         // The r.h.s. of an infix token begins a new block.
@@ -2562,24 +2565,28 @@ type LexFilterImpl (
               false
 
     and pushCtxtSeqBlock fallbackToken addBlockEnd =
-        pushCtxtSeqBlockAt strictIndentation fallbackToken (peekNextTokenTup()) addBlockEnd
+        pushCtxtSeqBlockAt strictIndentation true fallbackToken (peekNextTokenTup ()) addBlockEnd
+
+    and tryPushCtxtSeqBlock fallbackToken addBlockEnd =
+        pushCtxtSeqBlockAt strictIndentation false fallbackToken (peekNextTokenTup ()) addBlockEnd
 
-    and pushCtxtSeqBlockAt strict (fallbackToken: TokenTup) (tokenTup: TokenTup) addBlockEnd =
+    and pushCtxtSeqBlockAt strict (useFallback: bool) (fallbackToken: TokenTup) (tokenTup: TokenTup) addBlockEnd =
          let pushed = tryPushCtxt strict tokenTup (CtxtSeqBlock(FirstInSeqBlock, startPosOfTokenTup tokenTup, addBlockEnd))
-         if not pushed then
+         if not pushed && useFallback then
              // The upcoming token isn't sufficiently indented to start the new context.
              // The parser expects proper contexts structure, so we push a new recovery context at the fallback token position.
              pushCtxt fallbackToken (CtxtSeqBlock(NotFirstInSeqBlock, startPosOfTokenTup fallbackToken, addBlockEnd))
 
-         let addBlockBegin = 
-             match addBlockEnd with
-             | AddBlockEnd -> true
-             | _ -> false
+         if pushed || useFallback then
+             let addBlockBegin =
+                 match addBlockEnd with
+                 | AddBlockEnd -> true
+                 | _ -> false
 
-         if addBlockBegin then
-             if debug then dprintf "--> insert OBLOCKBEGIN \n"
-             let ctxtToken = if pushed then tokenTup else fallbackToken
-             delayToken(pool.UseLocation(ctxtToken, OBLOCKBEGIN))
+             if addBlockBegin then
+                 if debug then dprintf "--> insert OBLOCKBEGIN \n"
+                 let ctxtToken = if pushed then tokenTup else fallbackToken
+                 delayToken(pool.UseLocation(ctxtToken, OBLOCKBEGIN))
 
     let rec swTokenFetch() =
         let tokenTup = popNextTokenTup()

src/Compiler/pars.fsy

@@ -2787,6 +2787,12 @@ hardwhiteDoBinding:
         // associated with the module, 'main' function or assembly depending on their target
         BindingSetPreAttrs(mDo, false, false, (fun attrs vis -> attrs, [mkSynDoBinding (vis, mDo, $2, mAll)]), mAll), $2 }
 
+  | ODO ODECLEND
+      { let mDo = rhs parseState 1
+        reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsExpectingExpression ())
+        let seqPt = DebugPointAtBinding.NoneAtDo
+        let expr = arbExpr ("hardwhiteDoBinding1", mDo.EndRange)
+        BindingSetPreAttrs(mDo, false, false, (fun attrs vis -> attrs, [mkSynDoBinding (vis, mDo, expr, mDo)]), mDo), expr }
 
 /* The bindings in a class type definition */
 classDefnBindings:

tests/service/data/SyntaxTree/Expression/Do 03.fs.bsl

@@ -12,12 +12,12 @@ ImplFile
                     (None, SynValInfo ([], SynArgInfo ([], false, None)), None),
                   Wild (3,4--3,5), None,
                   Do
-                    (ArbitraryAfterError
-                       ("typedSequentialExprBlock1", (4,6--4,6)), (4,4--4,6)),
-                  (3,4--3,5), Yes (3,0--4,6), { LeadingKeyword = Let (3,0--3,3)
-                                                InlineKeyword = None
-                                                EqualsRange = Some (3,6--3,7) })],
-              (3,0--4,6)); Expr (Const (Int32 1, (6,0--6,1)), (6,0--6,1))],
+                    (ArbitraryAfterError ("hardwhiteDoBinding1", (4,6--4,6)),
+                     (4,4--4,6)), (3,4--3,5), Yes (3,0--4,6),
+                  { LeadingKeyword = Let (3,0--3,3)
+                    InlineKeyword = None
+                    EqualsRange = Some (3,6--3,7) })], (3,0--4,6));
+           Expr (Const (Int32 1, (6,0--6,1)), (6,0--6,1))],
           PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
           (1,0--6,1), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
       { ConditionalDirectives = []

tests/service/data/SyntaxTree/Expression/For 03.fs.bsl

@@ -14,16 +14,16 @@ ImplFile
                   ForEach
                     (Yes (4,4--4,7), Yes (4,10--4,12), SeqExprOnly false, true,
                      Wild (4,8--4,9), Const (Int32 1, (4,13--4,14)),
-                     ArbitraryAfterError
-                       ("typedSequentialExprBlock1", (4,17--4,17)), (4,4--4,17)),
-                  (3,4--3,5), NoneAtLet, { LeadingKeyword = Let (3,0--3,3)
-                                           InlineKeyword = None
-                                           EqualsRange = Some (3,6--3,7) })],
-              (3,0--4,17)); Expr (Const (Int32 3, (6,0--6,1)), (6,0--6,1))],
+                     ArbitraryAfterError ("forLoopBody2a", (6,0--6,1)),
+                     (4,4--4,17)), (3,4--3,5), NoneAtLet,
+                  { LeadingKeyword = Let (3,0--3,3)
+                    InlineKeyword = None
+                    EqualsRange = Some (3,6--3,7) })], (3,0--4,17));
+           Expr (Const (Int32 3, (6,0--6,1)), (6,0--6,1))],
           PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
           (1,0--6,1), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
       { ConditionalDirectives = []
         CodeComments = [] }, set []))
 
 (6,0)-(6,1) parse error Possible incorrect indentation: this token is offside of context started at position (4:5). Try indenting this token further or using standard formatting conventions.
-(6,0)-(6,1) parse error Expecting expression
+(6,0)-(6,1) parse error Incomplete structured construct at or before this point in expression

tests/service/data/SyntaxTree/Expression/While 03.fs.bsl

@@ -13,8 +13,7 @@ ImplFile
                   Wild (3,4--3,5), None,
                   While
                     (Yes (4,4--4,11), Const (Int32 1, (4,10--4,11)),
-                     ArbitraryAfterError
-                       ("typedSequentialExprBlock1", (4,14--4,14)), (4,4--4,14)),
+                     ArbitraryAfterError ("whileBody1", (6,0--6,1)), (4,4--4,14)),
                   (3,4--3,5), NoneAtLet, { LeadingKeyword = Let (3,0--3,3)
                                            InlineKeyword = None
                                            EqualsRange = Some (3,6--3,7) })],
@@ -25,4 +24,4 @@ ImplFile
         CodeComments = [] }, set []))
 
 (6,0)-(6,1) parse error Possible incorrect indentation: this token is offside of context started at position (4:5). Try indenting this token further or using standard formatting conventions.
-(6,0)-(6,1) parse error Expecting expression
+(6,0)-(6,1) parse error Incomplete structured construct at or before this point in expression

tests/service/data/SyntaxTree/Expression/While 04.fs.bsl

@@ -13,8 +13,7 @@ ImplFile
                   Wild (3,4--3,5), None,
                   While
                     (Yes (4,4--4,11), Const (Int32 1, (4,10--4,11)),
-                     ArbitraryAfterError
-                       ("typedSequentialExprBlock1", (4,14--4,14)), (4,4--4,14)),
+                     ArbitraryAfterError ("whileBody1", (5,0--5,0)), (4,4--4,14)),
                   (3,4--3,5), NoneAtLet, { LeadingKeyword = Let (3,0--3,3)
                                            InlineKeyword = None
                                            EqualsRange = Some (3,6--3,7) })],
@@ -25,4 +24,4 @@ ImplFile
         CodeComments = [] }, set []))
 
 (5,0)-(5,0) parse error Possible incorrect indentation: this token is offside of context started at position (4:5). Try indenting this token further or using standard formatting conventions.
-(5,0)-(5,0) parse error Expecting expression
+(5,0)-(5,0) parse error Incomplete structured construct at or before this point in expression

tests/service/data/SyntaxTree/Member/Do 03.fs.bsl

@@ -19,7 +19,7 @@ ImplFile
                                 SynValInfo ([], SynArgInfo ([], false, None)),
                                 None), Const (Unit, (5,11--5,13)), None,
                              ArbitraryAfterError
-                               ("typedSequentialExprBlock1", (5,13--5,13)),
+                               ("hardwhiteDoBinding1", (5,13--5,13)),
                              (5,11--5,13), NoneAtDo,
                              { LeadingKeyword =
                                 StaticDo ((5,4--5,10), (5,11--5,13))

tests/service/data/SyntaxTree/Member/Do 04.fs

@@ -0,0 +1,7 @@
+module Module
+
+type T =
+
+    do
+
+    do ()

tests/service/data/SyntaxTree/Member/Do 04.fs.bsl

@@ -0,0 +1,48 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Member/Do 04.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Types
+             ([SynTypeDefn
+                 (SynComponentInfo
+                    ([], None, [], [T],
+                     PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
+                     false, None, (3,5--3,6)),
+                  ObjectModel
+                    (Unspecified,
+                     [LetBindings
+                        ([SynBinding
+                            (None, Do, false, false, [], PreXmlDocEmpty,
+                             SynValData
+                               (None,
+                                SynValInfo ([], SynArgInfo ([], false, None)),
+                                None), Const (Unit, (5,4--5,6)), None,
+                             ArbitraryAfterError
+                               ("hardwhiteDoBinding1", (5,6--5,6)), (5,4--5,6),
+                             NoneAtDo, { LeadingKeyword = Do (5,4--5,6)
+                                         InlineKeyword = None
+                                         EqualsRange = None })], false, false,
+                         (5,4--5,6));
+                      LetBindings
+                        ([SynBinding
+                            (None, Do, false, false, [], PreXmlDocEmpty,
+                             SynValData
+                               (None,
+                                SynValInfo ([], SynArgInfo ([], false, None)),
+                                None), Const (Unit, (7,4--7,9)), None,
+                             Const (Unit, (7,7--7,9)), (7,4--7,9), NoneAtDo,
+                             { LeadingKeyword = Do (7,4--7,6)
+                               InlineKeyword = None
+                               EqualsRange = None })], false, false, (7,4--7,9))],
+                     (5,4--7,9)), [], None, (3,5--7,9),
+                  { LeadingKeyword = Type (3,0--3,4)
+                    EqualsRange = Some (3,7--3,8)
+                    WithKeyword = None })], (3,0--7,9))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--7,9), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(7,4)-(7,6) parse error Possible incorrect indentation: this token is offside of context started at position (5:5). Try indenting this token further or using standard formatting conventions.
+(7,4)-(7,6) parse error Expecting expression

tests/service/data/SyntaxTree/ModuleMember/Do 01.fs

@@ -0,0 +1,5 @@
+module Module
+
+do
+
+2

tests/service/data/SyntaxTree/ModuleMember/Do 01.fs.bsl

@@ -0,0 +1,17 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/ModuleMember/Do 01.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Expr
+             (Do
+                (ArbitraryAfterError ("hardwhiteDoBinding1", (3,2--3,2)),
+                 (3,0--3,2)), (3,0--3,2));
+           Expr (Const (Int32 2, (5,0--5,1)), (5,0--5,1))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--5,1), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(5,0)-(5,1) parse error Possible incorrect indentation: this token is offside of context started at position (3:1). Try indenting this token further or using standard formatting conventions.
+(5,0)-(5,1) parse error Expecting expression

tests/service/data/SyntaxTree/ModuleMember/Do 04.fs.bsl → tests/service/data/SyntaxTree/ModuleMember/Do 02.fs.bsl

@@ -1,16 +1,17 @@
 ImplFile
   (ParsedImplFileInput
-     ("/root/ModuleMember/Do 04.fs", false, QualifiedNameOfFile Module, [], [],
+     ("/root/ModuleMember/Do 02.fs", false, QualifiedNameOfFile Module, [], [],
       [SynModuleOrNamespace
          ([Module], false, NamedModule,
           [Expr
              (Do
-                (ArbitraryAfterError ("typedSequentialExprBlock1", (4,4--4,4)),
-                 (3,0--4,4)), (3,0--4,4));
+                (ArbitraryAfterError ("hardwhiteDoBinding1", (3,2--3,2)),
+                 (3,0--3,2)), (3,0--3,2));
            Expr (Const (Int32 2, (6,0--6,1)), (6,0--6,1))],
           PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
           (1,0--6,1), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
       { ConditionalDirectives = []
         CodeComments = [] }, set []))
 
+(4,0)-(4,4) parse error Possible incorrect indentation: this token is offside of context started at position (3:1). Try indenting this token further or using standard formatting conventions.
 (4,0)-(4,4) parse error Expecting expression