git.iko.soy/elk
on master help sign in
Make errors for binary operators much more specific
43d4388Evan Czaplicki
src/Reporting/Error/Type.hs+27
compare with master
unifiedsplit
@@ -3,7 +3,9 @@ module Reporting.Error.Type where
3
3
4import qualified Text.PrettyPrint as P
4import qualified Text.PrettyPrint as P
5
5
6+import qualified AST.Helpers as Help
6import qualified AST.Type as Type
7import qualified AST.Type as Type
8+import qualified AST.Variable as Var
7import qualified Reporting.PrettyPrint as P
9import qualified Reporting.PrettyPrint as P
8import qualified Reporting.Region as Region
10import qualified Reporting.Region as Region
9import qualified Reporting.Report as Report
11import qualified Reporting.Report as Report
@@ -32,6 +34,9 @@ data Hint
32 | If
34 | If
33 | List
35 | List
34 | ListElement Int Region.Region
36 | ListElement Int Region.Region
37+ | BinopLeft Var.Canonical Region.Region
38+ | BinopRight Var.Canonical Region.Region
39+ | Binop Var.Canonical
35
40
36
41
37data Note
42data Note
@@ -135,3 +140,25 @@ hintToString hint =
135 ++ "type does not match how it is used elsewhere."
140 ++ "type does not match how it is used elsewhere."
136 )
141 )
137
142
143+ BinopLeft op region ->
144+ ( Just region
145+ , "The left argument of " ++ prettyOperator op ++ " is causing a type mismatch."
146+ )
147+
148+ BinopRight op region ->
149+ ( Just region
150+ , "The right argument of " ++ prettyOperator op ++ " is causing a type mismatch."
151+ )
152+
153+ Binop op ->
154+ ( Nothing
155+ , "The two arguments to " ++ prettyOperator op ++ " are fine, but the overall type of this expression\n"
156+ ++ "does not match how it is used elsewhere."
157+ )
158+
159+
160+prettyOperator :: Var.Canonical -> String
161+prettyOperator (Var.Canonical _ opName) =
162+ if Help.isOp opName
163+ then "(" ++ opName ++ ")"
164+ else "`" ++ opName ++ "`"
src/Type/Constrain/Expression.hs+35−9
@@ -74,15 +74,7 @@ constrain env (A.A region expression) tipe =
74 constrainList env region exprs tipe
74 constrainList env region exprs tipe
75
75
76 E.Binop op leftExpr rightExpr ->
76 E.Binop op leftExpr rightExpr ->
77− exists $ \leftType ->
77+ constrainBinop env region op leftExpr rightExpr tipe
78− exists $ \rightType ->
79− do leftCon <- constrain env leftExpr leftType
80− rightCon <- constrain env rightExpr rightType
81− return $ CAnd
82− [ leftCon
83− , rightCon
84− , V.toString op <? (leftType ==> rightType ==> tipe)
85− ]
86
78
87 E.Lambda pattern body ->
79 E.Lambda pattern body ->
88 exists $ \argType ->
80 exists $ \argType ->
@@ -188,6 +180,40 @@ constrain env (A.A region expression) tipe =
188 constrain env expr tipe
180 constrain env expr tipe
189
181
190
182
183+-- CONSTRAIN BINOP
184+
185+constrainBinop
186+ :: Env.Environment
187+ -> R.Region
188+ -> V.Canonical
189+ -> Canonical.Expr
190+ -> Canonical.Expr
191+ -> Type
192+ -> IO TypeConstraint
193+constrainBinop env region op leftExpr@(A.A leftRegion _) rightExpr@(A.A rightRegion _) tipe =
194+ do leftVar <- variable Flexible
195+ rightVar <- variable Flexible
196+
197+ leftCon <- constrain env leftExpr (varN leftVar)
198+ rightCon <- constrain env rightExpr (varN rightVar)
199+
200+ leftVar' <- variable Flexible
201+ rightVar' <- variable Flexible
202+ answerVar <- variable Flexible
203+
204+ let opType = varN leftVar' ==> varN rightVar' ==> varN answerVar
205+
206+ return $
207+ ex [leftVar,rightVar,leftVar',rightVar',answerVar] $ CAnd $
208+ [ leftCon
209+ , rightCon
210+ , CInstance region (V.toString op) opType
211+ , CEqual (Error.BinopLeft op leftRegion) region (varN leftVar') (varN leftVar)
212+ , CEqual (Error.BinopRight op rightRegion) region (varN rightVar') (varN rightVar)
213+ , CEqual (Error.Binop op) region tipe (varN answerVar)
214+ ]
215+
216+
191-- CONSTRAIN LISTS
217-- CONSTRAIN LISTS
192
218
193constrainList
219constrainList