git.iko.soy/elk
on master help sign in
Better error messages for function arguments
c0df141Evan Czaplicki
src/Reporting/Error/Type.hs+55−16
compare with master
unifiedsplit
@@ -1,6 +1,7 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Error.Type where
2module Reporting.Error.Type where
3
3
4+import qualified Data.Char as Char
4import Text.PrettyPrint ((<+>))
5import Text.PrettyPrint ((<+>))
5import qualified Text.PrettyPrint as P
6import qualified Text.PrettyPrint as P
6
7
@@ -44,8 +45,9 @@ data Hint
44 | BinopLeft Var.Canonical Region.Region
45 | BinopLeft Var.Canonical Region.Region
45 | BinopRight Var.Canonical Region.Region
46 | BinopRight Var.Canonical Region.Region
46 | Binop Var.Canonical
47 | Binop Var.Canonical
47− | BadArgument Region.Region
48+ | Function (Maybe Var.Canonical)
48− | ExtraArgument Region.Region
49+ | UnexpectedArg (Maybe Var.Canonical) Int Region.Region
50+ | FunctionArity (Maybe Var.Canonical) Int Region.Region
49 | BadTypeAnnotation String
51 | BadTypeAnnotation String
50 | Instance String
52 | Instance String
51 | Literal String
53 | Literal String
@@ -53,7 +55,6 @@ data Hint
53 | Shader
55 | Shader
54 | Range
56 | Range
55 | Lambda
57 | Lambda
56− | App
57 | Record
58 | Record
58
59
59
60
@@ -116,7 +117,7 @@ hintToString hint =
116 CaseBranch branchNumber region ->
117 CaseBranch branchNumber region ->
117 ( Just region
118 ( Just region
118 , "The branches of this case-expression return different types of values.\n\n"
119 , "The branches of this case-expression return different types of values.\n\n"
119− ++ "I noticed the mismatch in branch #" ++ show branchNumber ++ ", but go through and make sure every\n"
120+ ++ "I noticed the mismatch in the " ++ ordinalize branchNumber ++ " branch, but go through and make sure every\n"
120 ++ "branch returns the same type of value."
121 ++ "branch returns the same type of value."
121 )
122 )
122
123
@@ -135,7 +136,7 @@ hintToString hint =
135 MultiIfBranch branchNumber region ->
136 MultiIfBranch branchNumber region ->
136 ( Just region
137 ( Just region
137 , "The branches of this if-expression return different types of values.\n\n"
138 , "The branches of this if-expression return different types of values.\n\n"
138− ++ "I noticed the mismatch in branch #" ++ show branchNumber ++ ", but go through and make sure every\n"
139+ ++ "I noticed the mismatch in the " ++ ordinalize branchNumber ++ " branch, but go through and make sure every\n"
139 ++ "branch returns the same type of value."
140 ++ "branch returns the same type of value."
140 )
141 )
141
142
@@ -148,7 +149,7 @@ hintToString hint =
148 ListElement elementNumber region ->
149 ListElement elementNumber region ->
149 ( Just region
150 ( Just region
150 , "Not all elements of this list are the same type of value.\n\n"
151 , "Not all elements of this list are the same type of value.\n\n"
151− ++ "I noticed the mismatch in element #" ++ show elementNumber ++ ", but go through and make sure every\n"
152+ ++ "I noticed the mismatch in the " ++ ordinalize elementNumber ++ " element, but go through and make sure every\n"
152 ++ "element is the same type of value."
153 ++ "element is the same type of value."
153 )
154 )
154
155
@@ -174,15 +175,21 @@ hintToString hint =
174 ++ "does not match how it is used elsewhere."
175 ++ "does not match how it is used elsewhere."
175 )
176 )
176
177
177− BadArgument region ->
178+ Function maybeName ->
179+ ( Nothing
180+ , "The return type of " ++ funcName maybeName ++ " is being used in unexpected ways."
181+ )
182+
183+ UnexpectedArg maybeName index region ->
178 ( Just region
184 ( Just region
179− , "This argument is causing a type mismatch."
185+ , "The " ++ ordinalize index ++ " argument to " ++ funcName maybeName
186+ ++ " has an unexpected type."
180 )
187 )
181
188
182− ExtraArgument region ->
189+ FunctionArity maybeName index region ->
183 ( Just region
190 ( Just region
184− , "This expression is mistakenly being used as a function.\n"
191+ , capitalize (funcName maybeName) ++ " is not expecting a "
185− ++ "Maybe you provided an extra argument?"
192+ ++ ordinalize index ++ " argument."
186 )
193 )
187
194
188 BadTypeAnnotation name ->
195 BadTypeAnnotation name ->
@@ -228,11 +235,6 @@ hintToString hint =
228 , "This anonymous function is being used in an unexpected way."
235 , "This anonymous function is being used in an unexpected way."
229 )
236 )
230
237
231− App ->
232− ( Nothing
233− , "The result of this function application is being used in an unexpected way."
234− )
235−
236 Record ->
238 Record ->
237 ( Nothing
239 ( Nothing
238 , "This record is being used in an unexpected way."
240 , "This record is being used in an unexpected way."
@@ -244,3 +246,40 @@ prettyOperator (Var.Canonical _ opName) =
244 if Help.isOp opName
246 if Help.isOp opName
245 then "(" ++ opName ++ ")"
247 then "(" ++ opName ++ ")"
246 else "`" ++ opName ++ "`"
248 else "`" ++ opName ++ "`"
249+
250+
251+funcName :: Maybe Var.Canonical -> String
252+funcName maybeVar =
253+ case maybeVar of
254+ Nothing ->
255+ "this function"
256+
257+ Just var ->
258+ "function " ++ prettyOperator var
259+
260+
261+capitalize :: String -> String
262+capitalize string =
263+ case string of
264+ [] -> []
265+ c : cs ->
266+ Char.toUpper c : cs
267+
268+
269+ordinalize :: Int -> String
270+ordinalize number =
271+ let
272+ remainder10 =
273+ number `mod` 10
274+
275+ remainder100 =
276+ number `mod` 100
277+
278+ ending
279+ | remainder100 `elem` [11..13] = "th"
280+ | remainder10 == 1 = "st"
281+ | remainder10 == 2 = "nd"
282+ | remainder10 == 3 = "rd"
283+ | otherwise = "th"
284+ in
285+ show number ++ ending
src/Type/Constrain/Expression.hs+85−20
@@ -27,7 +27,7 @@ constrain
27 -> Canonical.Expr
27 -> Canonical.Expr
28 -> Type
28 -> Type
29 -> IO TypeConstraint
29 -> IO TypeConstraint
30−constrain env (A.A region expression) tipe =
30+constrain env annotatedExpr@(A.A region expression) tipe =
31 let list t = Env.get env Env.types "List" <| t
31 let list t = Env.get env Env.types "List" <| t
32 (<?) = CInstance region
32 (<?) = CInstance region
33 in
33 in
@@ -91,25 +91,11 @@ constrain env (A.A region expression) tipe =
91 )
91 )
92 return $ con /\ CEqual Error.Lambda region tipe (argType ==> resType)
92 return $ con /\ CEqual Error.Lambda region tipe (argType ==> resType)
93
93
94− E.App func@(A.A funcRegion _) arg@(A.A argRegion _) ->
94+ E.App _ _ ->
95− do argVar <- variable Flexible
95+ let
96− argCon <- constrain env arg (varN argVar)
96+ (f:args) = E.collectApps annotatedExpr
97−
97+ in
98− funcVar <- variable Flexible
98+ constrainApp env region f args tipe
99− funcCon <- constrain env func (varN funcVar)
100−
101− argVar' <- variable Flexible
102− resultVar <- variable Flexible
103−
104− return $ ex [funcVar, argVar, argVar', resultVar] $ CAnd $
105− [ argCon
106− , funcCon
107− , CEqual (Error.ExtraArgument funcRegion) region
108− (varN funcVar)
109− (varN argVar' ==> varN resultVar)
110− , CEqual (Error.BadArgument argRegion) region (varN argVar') (varN argVar)
111− , CEqual Error.App region tipe (varN resultVar)
112− ]
113
99
114 E.MultiIf branches ->
100 E.MultiIf branches ->
115 constrainIf env region branches tipe
101 constrainIf env region branches tipe
@@ -199,6 +185,85 @@ constrain env (A.A region expression) tipe =
199 constrain env expr tipe
185 constrain env expr tipe
200
186
201
187
188+-- CONSTRAIN APP
189+
190+constrainApp
191+ :: Env.Environment
192+ -> R.Region
193+ -> Canonical.Expr
194+ -> [Canonical.Expr]
195+ -> Type
196+ -> IO TypeConstraint
197+constrainApp env region f args tipe =
198+ do funcVar <- variable Flexible
199+ funcCon <- constrain env f (varN funcVar)
200+
201+ (vars, numberOfArgsCons, argCons, argMatchCons, returnVar) <-
202+ argConstraints env maybeName region funcVar 1 args
203+
204+ let returnCon =
205+ CEqual (Error.Function maybeName) region (varN returnVar) tipe
206+
207+ return $ ex (funcVar : vars) $
208+ CAnd (funcCon : argCons ++ numberOfArgsCons ++ argMatchCons ++ [returnCon])
209+ where
210+ maybeName =
211+ case f of
212+ A.A _ (E.Var canonicalName) ->
213+ Just canonicalName
214+
215+ _ ->
216+ Nothing
217+
218+
219+argConstraints
220+ :: Env.Environment
221+ -> Maybe V.Canonical
222+ -> R.Region
223+ -> Variable
224+ -> Int
225+ -> [Canonical.Expr]
226+ -> IO ([Variable], [TypeConstraint], [TypeConstraint], [TypeConstraint], Variable)
227+argConstraints env name region overallVar index args =
228+ case args of
229+ [] ->
230+ return ([], [], [], [], overallVar)
231+
232+ expr@(A.A subregion _) : rest ->
233+ do argVar <- variable Flexible
234+ argCon <- constrain env expr (varN argVar)
235+
236+ argIndexVar <- variable Flexible
237+ localReturnVar <- variable Flexible
238+
239+ let numberOfArgsCon =
240+ CEqual
241+ (Error.FunctionArity name index subregion)
242+ region
243+ (varN argIndexVar ==> varN localReturnVar)
244+ (varN overallVar)
245+
246+ let argMatchCon =
247+ CEqual
248+ (Error.UnexpectedArg name index subregion)
249+ region
250+ (varN argIndexVar)
251+ (varN argVar)
252+
253+ (vars, numberOfArgsRest, argConRest, argMatchRest, returnVar) <-
254+ argConstraints env name region localReturnVar (index + 1) rest
255+
256+ return
257+ ( argVar : argIndexVar : localReturnVar : vars
258+ , numberOfArgsCon : numberOfArgsRest
259+ , argCon : argConRest
260+ , argMatchCon : argMatchRest
261+ , returnVar
262+ )
263+
264+
265+
266+
202-- CONSTRAIN BINOP
267-- CONSTRAIN BINOP
203
268
204constrainBinop
269constrainBinop