Better error message for pattern matching (#3157)

* Better error message for pattern matching

* Better error message for pattern matching guards

* fix test

* Test pattern match guards

* s/return type/have type

src/fsharp/CompileOps.fs

@@ -646,6 +646,8 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) =
                 os.Append(FSComp.SR.listElementHasWrongType(t1,t2)) |> ignore
           | ContextInfo.OmittedElseBranch range when range = m -> os.Append(FSComp.SR.missingElseBranch(t2)) |> ignore
           | ContextInfo.ElseBranchResult range when range = m -> os.Append(FSComp.SR.elseBranchHasWrongType(t1,t2)) |> ignore
+          | ContextInfo.FollowingPatternMatchClause range when range = m -> os.Append(FSComp.SR.followingPatternMatchClauseHasWrongType(t1,t2)) |> ignore
+          | ContextInfo.PatternMatchGuard range when range = m -> os.Append(FSComp.SR.patternMatchGuardIsNotBool(t2)) |> ignore
           | _ -> os.Append(ConstraintSolverTypesNotInEqualityRelation2E().Format t1 t2) |> ignore
           if m.StartLine <> m2.StartLine then 
              os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore
@@ -677,6 +679,8 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) =
                 os.Append(FSComp.SR.listElementHasWrongType(t1,t2)) |> ignore
           | ContextInfo.OmittedElseBranch range when range = m -> os.Append(FSComp.SR.missingElseBranch(t2)) |> ignore
           | ContextInfo.ElseBranchResult range when range = m -> os.Append(FSComp.SR.elseBranchHasWrongType(t1,t2)) |> ignore
+          | ContextInfo.FollowingPatternMatchClause range when range = m -> os.Append(FSComp.SR.followingPatternMatchClauseHasWrongType(t1,t2)) |> ignore
+          | ContextInfo.PatternMatchGuard range when range = m -> os.Append(FSComp.SR.patternMatchGuardIsNotBool(t2)) |> ignore
           | ContextInfo.TupleInRecordFields ->
                 os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore
                 os.Append(System.Environment.NewLine + FSComp.SR.commaInsteadOfSemicolonInRecord()) |> ignore

src/fsharp/ConstraintSolver.fs

@@ -137,6 +137,10 @@ type ContextInfo =
 | RuntimeTypeTest of bool
 /// The type equation comes from an downcast where a upcast could be used.
 | DowncastUsedInsteadOfUpcast of bool
+/// The type equation comes from a return type of a pattern match clause (not the first clause).
+| FollowingPatternMatchClause of range
+/// The type equation comes from a pattern match guard.
+| PatternMatchGuard of range
 
 exception ConstraintSolverTupleDiffLengths of DisplayEnv * TType list * TType list * range  * range 
 exception ConstraintSolverInfiniteTypes of ContextInfo * DisplayEnv * TType * TType * range * range

src/fsharp/ConstraintSolver.fsi

@@ -72,6 +72,11 @@ type ContextInfo =
 | RuntimeTypeTest of bool
 /// The type equation comes from an downcast where a upcast could be used.
 | DowncastUsedInsteadOfUpcast of bool
+/// The type equation comes from a return type of a pattern match clause (not the first clause).
+| FollowingPatternMatchClause of range
+/// The type equation comes from a pattern match guard.
+| PatternMatchGuard of range
+
 
 exception ConstraintSolverTupleDiffLengths              of DisplayEnv * TType list * TType list * range * range
 exception ConstraintSolverInfiniteTypes                 of ContextInfo * DisplayEnv * TType * TType * range * range

src/fsharp/FSComp.txt

@@ -21,7 +21,9 @@ listElementHasWrongType,"All elements of a list constructor expression must have
 arrayElementHasWrongType,"All elements of an array constructor expression must have the same type. This expression was expected to have type '%s', but here has type '%s'."
 missingElseBranch,"The 'if' expression is missing an 'else' branch. The 'then' branch has type '%s'. Because 'if' is an expression, and not a statement, add an 'else' branch which returns a value of the same type."
 ifExpression,"The 'if' expression needs to have type '%s' to satisfy context type requirements. It currently has type '%s'."
-elseBranchHasWrongType,"All branches of an 'if' expression must return the same type. This expression was expected to have type '%s', but here has type '%s'."
+elseBranchHasWrongType,"All branches of an 'if' expression must have the same type. This expression was expected to have type '%s', but here has type '%s'."
+followingPatternMatchClauseHasWrongType,"All branches of a pattern match expression must have the same type. This expression was expected to have type '%s', but here has type '%s'."
+patternMatchGuardIsNotBool,"A pattern match guard must be of type 'bool', but this 'when' expression is of type '%s'."
 commaInsteadOfSemicolonInRecord,"A ';' is used to separate field values in records. Consider replacing ',' with ';'."
 derefInsteadOfNot,"The '!' operator is used to dereference a ref cell. Consider using 'not expr' here."
 buildUnexpectedTypeArgs,"The non-generic type '%s' does not expect any type arguments, but here is given %d type argument(s)"

src/fsharp/TypeChecker.fs

@@ -10082,15 +10082,24 @@ and TcMatchPattern cenv inputTy env tpenv (pat:SynPat,optWhenExpr) =
     let m = pat.Range
     let patf',(tpenv,names,_) = TcPat WarnOnUpperCase cenv env None (ValInline.Optional,permitInferTypars,noArgOrRetAttribs,false,None,false) (tpenv,Map.empty,Set.empty) inputTy pat
     let envinner,values,vspecMap = MakeAndPublishSimpleVals cenv env m names false
-    let optWhenExpr',tpenv = Option.mapFold (TcExpr cenv cenv.g.bool_ty envinner) tpenv optWhenExpr
+    let optWhenExpr',tpenv = 
+        match optWhenExpr with
+        | Some whenExpr ->
+            let guardEnv = { envinner with eContextInfo = ContextInfo.PatternMatchGuard whenExpr.Range }
+            let whenExpr',tpenv  = TcExpr cenv cenv.g.bool_ty guardEnv tpenv whenExpr
+            Some whenExpr',tpenv
+        | None -> None,tpenv
     patf' (TcPatPhase2Input (values, true)),optWhenExpr', NameMap.range vspecMap,envinner,tpenv
 
 and TcMatchClauses cenv inputTy resultTy env tpenv clauses =
-    List.mapFold (TcMatchClause cenv inputTy resultTy env) tpenv clauses 
+    let first = ref true
+    let isFirst() = if !first then first := false; true else false
+    List.mapFold (fun clause -> TcMatchClause cenv inputTy resultTy env (isFirst()) clause) tpenv clauses
 
-and TcMatchClause cenv inputTy resultTy env tpenv (Clause(pat,optWhenExpr,e,patm,spTgt)) =
+and TcMatchClause cenv inputTy resultTy env isFirst tpenv (Clause(pat,optWhenExpr,e,patm,spTgt)) =
     let pat',optWhenExpr',vspecs,envinner,tpenv = TcMatchPattern cenv inputTy env tpenv (pat,optWhenExpr)
-    let e',tpenv = TcExprThatCanBeCtorBody cenv resultTy envinner tpenv e
+    let resultEnv = if isFirst then envinner else { envinner with eContextInfo = ContextInfo.FollowingPatternMatchClause e.Range }
+    let e',tpenv = TcExprThatCanBeCtorBody cenv resultTy resultEnv tpenv e
     TClause(pat',optWhenExpr',TTarget(vspecs, e',spTgt),patm),tpenv
 
 and TcStaticOptimizationConstraint cenv env tpenv c = 

tests/fsharp/typecheck/sigs/neg20.bsl

@@ -110,12 +110,9 @@ but given a
     'B list'    
 The type 'A' does not match the type 'B'
 
-neg20.fs(83,47,83,54): typecheck error FS0001: All branches of an 'if' expression must return the same type. This expression was expected to have type 'B', but here has type 'C'.
+neg20.fs(83,47,83,54): typecheck error FS0001: All branches of an 'if' expression must have the same type. This expression was expected to have type 'B', but here has type 'C'.
 
-neg20.fs(87,54,87,61): typecheck error FS0001: This expression was expected to have type
-    'B'    
-but here has type
-    'C'    
+neg20.fs(87,54,87,61): typecheck error FS0001: All branches of a pattern match expression must have the same type. This expression was expected to have type 'B', but here has type 'C'.
 
 neg20.fs(92,19,92,26): typecheck error FS0001: This expression was expected to have type
     'A'    

tests/fsharp/typecheck/sigs/neg80.vsbsl

@@ -3,9 +3,6 @@ neg80.fsx(79,5,79,6): parse error FS0010: Unexpected symbol '|' in pattern match
 
 neg80.fsx(79,5,79,6): parse error FS0010: Unexpected symbol '|' in pattern matching
 
-neg80.fsx(79,6,79,6): typecheck error FS0001: This expression was expected to have type
-    'string'    
-but here has type
-    'unit'    
+neg80.fsx(79,6,79,6): typecheck error FS0001: All branches of a pattern match expression must have the same type. This expression was expected to have type 'string', but here has type 'unit'.
 
 neg80.fsx(76,11,76,13): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'Horizontal (_, _)' may indicate a case not covered by the pattern(s).

tests/fsharpqa/Source/Warnings/ElseBranchHasWrongType.fs

 // #Warnings
-//<Expects status="Error" span="(7,10)" id="FS0001">All branches of an 'if' expression must return the same type. This expression was expected to have type 'string', but here has type 'int'.</Expects>
+//<Expects status="Error" span="(7,10)" id="FS0001">All branches of an 'if' expression must have the same type. This expression was expected to have type 'string', but here has type 'int'.</Expects>
 
 let test = 100
 let y =
     if test > 10 then "test"
     else 123
     
-exit 0
\ No newline at end of file
+exit 0

tests/fsharpqa/Source/Warnings/ElseBranchHasWrongType2.fs

 // #Warnings
-//<Expects status="Error" id="FS0001">All branches of an 'if' expression must return the same type. This expression was expected to have type 'string', but here has type 'int'.</Expects>
+//<Expects status="Error" id="FS0001">All branches of an 'if' expression must have the same type. This expression was expected to have type 'string', but here has type 'int'.</Expects>
 
 let test = 100
 let f x = test
@@ -7,4 +7,4 @@ let y =
     if test > 10 then "test"
     else f 10
     
-exit 0
\ No newline at end of file
+exit 0

tests/fsharpqa/Source/Warnings/GuardHasWrongType.fs

+// #Warnings
+//<Expects status="Error" id="FS0001">A pattern match guard must be of type 'bool'</Expects>
+
+let x = 1
+match x with
+| 1 when "s" -> true
+| _ -> false
+    
+exit 0
\ No newline at end of file

tests/fsharpqa/Source/Warnings/NestedElseBranchHasWrongType.fs

 // #Warnings
-//<Expects status="Error" id="FS0001">All branches of an 'if' expression must return the same type.</Expects>
+//<Expects status="Error" id="FS0001">All branches of an 'if' expression must have the same type.</Expects>
 
 let x = 1
 if x = 1 then true

tests/fsharpqa/Source/Warnings/env.lst

@@ -43,6 +43,7 @@
 	SOURCE=DontSuggestWhenThingsAreOpen.fs SCFLAGS="--vserrors" # DontSuggestWhenThingsAreOpen.fs
 	SOURCE=SuggestDoubleBacktickIdentifiers.fs SCFLAGS="--vserrors" # SuggestDoubleBacktickIdentifiers.fs
 	SOURCE=SuggestDoubleBacktickUnions.fs SCFLAGS="--vserrors" # SuggestDoubleBacktickUnions.fs
+	SOURCE=GuardHasWrongType.fs # GuardHasWrongType.fs
 	SOURCE=ElseBranchHasWrongType.fs # ElseBranchHasWrongType.fs
 	SOURCE=ElseBranchHasWrongType2.fs # ElseBranchHasWrongType2.fs
 	SOURCE=NestedElseBranchHasWrongType.fs # NestedElseBranchHasWrongType.fs