on master help sign in
Improve type error messages for if-expressions
ca5f9daEvan Czaplicki
src/Reporting/Error/Type.hs+17−14
@@ -26,9 +26,9 @@ data Hint
26 = None
26 = None
27 | Custom String
27 | Custom String
28 | CaseBranch Int Region.Region
28 | CaseBranch Int Region.Region
29− -- | Then Region.Region
29+ | IfBranches
30− -- | Else Region.Region
31− -- | IfBranch Int Region.Region
30+ | MultiIfBranch Int Region.Region
31+ | If
32
32
33
33
34mergeHint :: Hint -> Maybe String -> Hint
34mergeHint :: Hint -> Maybe String -> Hint
@@ -88,23 +88,26 @@ hintToString hint =
88
88
89 CaseBranch branchNumber region ->
89 CaseBranch branchNumber region ->
90 ( Just region
90 ( Just region
91− , "The branches of this case-expression return different types of values!\n\n"
91+ , "The branches of this case-expression return different types of values.\n\n"
92 ++ "I noticed the mismatch in branch #" ++ show branchNumber ++ ", but go through and make sure every\n"
92 ++ "I noticed the mismatch in branch #" ++ show branchNumber ++ ", but go through and make sure every\n"
93 ++ "branch returns the same type of value."
93 ++ "branch returns the same type of value."
94 )
94 )
95−{--
95+
96− Then region ->
96+ IfBranches ->
97− ( Just region
97+ ( Nothing
98− , ""
98+ , "The branches of this if-expression return different types of values.\n"
99+ ++ "All branches must have the same return type!"
99 )
100 )
100
101
101− Else region ->
102+ MultiIfBranch branchNumber region ->
102 ( Just region
103 ( Just region
103− , ""
104+ , "The branches of this if-expression return different types of values.\n\n"
105+ ++ "I noticed the mismatch in branch #" ++ show branchNumber ++ ", but go through and make sure every\n"
106+ ++ "branch returns the same type of value."
104 )
107 )
105
108
106− IfBranch branchNumber region ->
109+ If ->
107− ( Just region
110+ ( Nothing
108− , ""
111+ , "All the branches of this if-expression are consistent, but the overall return\n"
112+ ++ "type does not match how it is used elsewhere."
109 )
113 )
110−--}
src/Type/Constrain/Expression.hs+54−8
@@ -105,14 +105,7 @@ constrain env (A.A region expression) tipe =
105 return (funcCon /\ argCon)
105 return (funcCon /\ argCon)
106
106
107 E.MultiIf branches ->
107 E.MultiIf branches ->
108− CAnd <$> mapM constrain' branches
108+ constrainIf env region branches tipe
109− where
110− bool = Env.get env Env.types "Bool"
111−
112− constrain' (cond, expr) =
113− do cb <- constrain env cond bool
114− ce <- constrain env expr tipe
115− return (cb /\ ce)
116
109
117 E.Case expr branches ->
110 E.Case expr branches ->
118 constrainCase env region expr branches tipe
111 constrainCase env region expr branches tipe
@@ -194,6 +187,59 @@ constrain env (A.A region expression) tipe =
194 constrain env expr tipe
187 constrain env expr tipe
195
188
196
189
190+-- CONSTRAIN IF EXPRESSIONS
191+
192+constrainIf
193+ :: Env.Environment
194+ -> R.Region
195+ -> [(Canonical.Expr, Canonical.Expr)]
196+ -> Type
197+ -> IO TypeConstraint
198+constrainIf env region branches tipe =
199+ do (branchInfo, branchExprCons) <-
200+ unzip <$> mapM constrainBranch branches
201+
202+ return $
203+ ex (map fst branchInfo)
204+ (CAnd (branchExprCons ++ branchCons branchInfo))
205+ where
206+ bool = Env.get env Env.types "Bool"
207+
208+ constrainBranch (cond, expr@(A.A branchRegion _)) =
209+ do branchVar <- variable Flexible
210+ condCon <- constrain env cond bool
211+ exprCon <- constrain env expr (varN branchVar)
212+ return
213+ ( (branchVar, branchRegion)
214+ , condCon /\ exprCon
215+ )
216+
217+ branchCons branchInfo =
218+ case branchInfo of
219+ [(thenVar, _), (elseVar, _)] ->
220+ [ CEqual Error.IfBranches region (varN thenVar) (varN elseVar)
221+ , CEqual Error.If region tipe (varN thenVar)
222+ ]
223+
224+ _ ->
225+ buildBranchCons 2 branchInfo
226+
227+ buildBranchCons n branchInfo =
228+ case branchInfo of
229+ [] ->
230+ []
231+
232+ (var,_) : [] ->
233+ [ CEqual Error.If region tipe (varN var) ]
234+
235+ (var,_) : (var',region') : rest ->
236+ let
237+ hint = Error.MultiIfBranch n region'
238+ con = CEqual hint region (varN var) (varN var')
239+ in
240+ con : buildBranchCons (n+1) ((var', region') : rest)
241+
242+
197-- CONSTRAIN CASE EXPRESSIONS
243-- CONSTRAIN CASE EXPRESSIONS
198
244
199constrainCase
245constrainCase