Better diagnostics

Author: auduchinok

src/fsharp/pars.fsy

@@ -36,9 +36,6 @@ let debugPrint s = ignore s
 
 let exprFromParseError (e:SynExpr) = SynExpr.FromParseError (e, e.Range)
 
-let unitExprFromRange m = SynExpr.Const (SynConst.Unit, m)
-let unitExprFromParseError m = unitExprFromRange m |> exprFromParseError
-
 let patFromParseError (e:SynPat) = SynPat.FromParseError(e, e.Range)
 
 // record bindings returned by the recdExprBindings rule has shape:
@@ -319,7 +316,8 @@ let rangeOfLongIdent(lid:LongIdent) =
 %type <Ident> ident
 %type <SynType> typ typEOF
 %type <SynTypeDefnSig list> tyconSpfnList
-%type <SynArgPats> atomicPatsOrNamePatPairs
+%type <SynArgPats * Range> atomicPatsOrNamePatPairs
+%type <SynPat list> atomicPatterns
 %type <Range * SynExpr> patternResult
 %type <SynExpr> declExpr
 %type <SynExpr> minusExpr
@@ -3106,33 +3104,39 @@ constrPattern:
 
   | atomicPatternLongIdent explicitValTyparDecls atomicPatsOrNamePatPairs %prec pat_app
       { let vis, lid = $1
-        let m = (rhs2 parseState 1 2, $3.Patterns) ||> unionRangeWithListBy (fun p -> p.Range)
-        SynPat.LongIdent (lid, None, Some $2, $3, vis, m) }
+        let args, argsM = $3
+        let m = unionRanges (rhs2 parseState 1 2) argsM
+        SynPat.LongIdent (lid, None, Some $2, args, vis, m) }
 
   | atomicPatternLongIdent explicitValTyparDecls HIGH_PRECEDENCE_PAREN_APP atomicPatsOrNamePatPairs
       { let vis, lid = $1
-        let m = (rhs2 parseState 1 2, $4.Patterns) ||> unionRangeWithListBy (fun p -> p.Range)
-        SynPat.LongIdent (lid, None, Some $2, $4, vis, m) }
+        let args, argsM = $4
+        let m = unionRanges (rhs2 parseState 1 2) argsM
+        SynPat.LongIdent (lid, None, Some $2, args, vis, m) }
 
   | atomicPatternLongIdent explicitValTyparDecls HIGH_PRECEDENCE_BRACK_APP atomicPatsOrNamePatPairs
       { let vis, lid = $1
-        let m = (rhs2 parseState 1 2, $4.Patterns) ||> unionRangeWithListBy (fun p -> p.Range)
-        SynPat.LongIdent (lid, None, Some $2, $4, vis, m) }
+        let args, argsM = $4
+        let m = unionRanges (rhs2 parseState 1 2) argsM
+        SynPat.LongIdent (lid, None, Some $2, args, vis, m) }
 
   | atomicPatternLongIdent atomicPatsOrNamePatPairs %prec pat_app
       { let vis, lid = $1
-        let m = (rhs parseState 1, $2.Patterns) ||> unionRangeWithListBy (fun p -> p.Range)
-        SynPat.LongIdent (lid, None, None, $2, vis, m) }
+        let args, argsM = $2
+        let m = unionRanges (rhs parseState 1) argsM
+        SynPat.LongIdent (lid, None, None, args, vis, m) }
 
   | atomicPatternLongIdent HIGH_PRECEDENCE_PAREN_APP atomicPatsOrNamePatPairs
       { let vis, lid = $1
-        let m = (rhs parseState 1, $3.Patterns) ||> unionRangeWithListBy (fun p -> p.Range)
-        SynPat.LongIdent (lid, None, None, $3, vis, m) }
+        let args, argsM = $3
+        let m = unionRanges (rhs parseState 1) argsM
+        SynPat.LongIdent (lid, None, None, args, vis, m) }
 
   | atomicPatternLongIdent HIGH_PRECEDENCE_BRACK_APP atomicPatsOrNamePatPairs
       { let vis, lid = $1
-        let m = (rhs parseState 1, $3.Patterns) ||> unionRangeWithListBy (fun p -> p.Range)
-        SynPat.LongIdent (lid, None, None, $3, vis, m) }
+        let args, argsM = $3
+        let m = unionRanges (rhs parseState 1) argsM
+        SynPat.LongIdent (lid, None, None, args, vis, m) }
 
   | COLON_QMARK atomTypeOrAnonRecdType  %prec pat_isinst 
       { SynPat.IsInst($2, lhs parseState) }
@@ -3142,10 +3146,13 @@ constrPattern:
 
 atomicPatsOrNamePatPairs:
   | LPAREN namePatPairs rparen
-      { SynArgPats.NamePatPairs $2 }
+      { let m = rhs2 parseState 1 3
+        SynArgPats.NamePatPairs $2, m }
 
   | atomicPatterns
-      { SynArgPats.Pats $1 }
+      { let mWhole = rhs parseState 1
+        let m = (mWhole.StartRange, $1) ||> unionRangeWithListBy (fun p -> p.Range)
+        SynArgPats.Pats $1, m }
 
 atomicPatterns: 
   | atomicPattern atomicPatterns %prec pat_args 
@@ -3993,7 +4000,7 @@ patternClauses:
      { let pat, guard, patm = $1 
        let clauses, mLast = $4
        let m = guard |> Option.map (fun e -> unionRanges patm e.Range) |> Option.defaultValue patm
-       (SynMatchClause(pat, guard, None, unitExprFromParseError m.EndRange, m, DebugPointAtTarget.Yes) :: clauses), mLast }
+       (SynMatchClause(pat, guard, None, arbExpr ("patternClauses1", m.EndRange), m, DebugPointAtTarget.Yes) :: clauses), mLast }
 
   | patternAndGuard patternResult BAR error 
      { let pat, guard, patm = $1 
@@ -4016,7 +4023,7 @@ patternClauses:
        let mLast = rhs parseState 2
        let m = guard |> Option.map (fun e -> unionRanges patm e.Range) |> Option.defaultValue patm
        // silent recovery 
-       [SynMatchClause(pat, guard, None, unitExprFromParseError m.EndRange, m, DebugPointAtTarget.Yes)], mLast }
+       [SynMatchClause(pat, guard, None, arbExpr ("patternClauses2", m.EndRange), m, DebugPointAtTarget.Yes)], mLast }
 
 patternGuard: 
   | WHEN declExpr 

tests/service/ParserTests.fs

@@ -51,7 +51,7 @@ match () with
 | x
 """
     match getSingleExprInModule parseResults with
-    | SynExpr.Match (_, _, [ SynMatchClause (_, _, _, SynExpr.FromParseError _, _, _) ], _) -> ()
+    | SynExpr.Match (_, _, [ SynMatchClause (_, _, _, SynExpr.ArbitraryAfterError _, _, _) ], _) -> ()
     | _ -> failwith "Unexpected tree"
 
 
@@ -63,7 +63,7 @@ match () with
 """
 
     match getSingleExprInModule parseResults with
-    | SynExpr.Match (_, _, [ SynMatchClause (_, _, _, SynExpr.FromParseError _, _, _) ], _) -> ()
+    | SynExpr.Match (_, _, [ SynMatchClause (_, _, _, SynExpr.ArbitraryAfterError _, _, _) ], _) -> ()
     | _ -> failwith "Unexpected tree"
 
 [<Test>]
@@ -75,5 +75,5 @@ match () with
 """
 
     match getSingleExprInModule parseResults with
-    | SynExpr.Match (_, _, [ SynMatchClause (_, _, _, SynExpr.FromParseError _, _, _); _ ], _) -> ()
+    | SynExpr.Match (_, _, [ SynMatchClause (_, _, _, SynExpr.ArbitraryAfterError _, _, _); _ ], _) -> ()
     | _ -> failwith "Unexpected tree"