66b6726 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Produce better error messages on "too many args"

66b6726Evan Czaplicki9 years ago

compiler/src/Reporting/Error/Type.hs+39−12

compare with master

unifiedsplit

@@ -60,6 +60,7 @@ data Context

60 | IfCondition

61 | IfBranch Index.ZeroBased

62 | CaseBranch Index.ZeroBased

63+ | CallArity MaybeName Int

63 | CallArg MaybeName Index.ZeroBased

64 | CallArg MaybeName Index.ZeroBased

64 | TooManyArgs MaybeName Int

65 | TooManyArgs MaybeName Int

65 | RecordAccess N.Name

66 | RecordAccess N.Name

@@ -796,22 +797,48 @@ toExprReport source localizer exprRegion category tipe expected =

796 )

797 )

798 )

798

799

800+ CallArity maybeFuncName numArgs ->

801+ case countArgs tipe of

802+ 0 ->

803+ Report.toCodeSnippet source region (Just exprRegion)

804+ ( H.reflow $

805+ case maybeFuncName of

806+ NoName -> "This is not a function:"

807+ FuncName name -> "The `" <> N.toString name <> "` value is not a function:"

808+ CtorName name -> "The `" <> N.toString name <> "` value is not a function:"

809+ OpName op -> "The (" <> N.toString op <> ") operator is not a function:"

810+ ,

811+ H.stack $

812+ [ "It has type:"

813+ , H.indent 4 $ H.dullyellow $ T.toDoc localizer RT.None tipe

814+ , H.reflow $ "So it cannot accept arguments, but it got " <> show numArgs <> " anyway."

815+ ]

816+ )

817+

818+ n ->

819+ Report.toCodeSnippet source region (Just exprRegion)

820+ ( H.reflow $

821+ case maybeFuncName of

822+ NoName -> "This function was given too many arguments:"

823+ FuncName name -> "The `" <> N.toString name <> "` function was given too many arguments:"

824+ CtorName name -> "The `" <> N.toString name <> "` constructor was given too many arguments:"

825+ OpName op -> "The (" <> N.toString op <> ") operator was given too many arguments:"

826+ ,

827+ H.stack $

828+ [ "It has type:"

829+ , H.indent 4 $ H.dullyellow $ T.toDoc localizer RT.None tipe

830+ , H.reflow $ "So it expects " <> H.args n <> ", but it got " <> show numArgs <> " instead."

831+ ]

832+ )

833+

799 CallArg maybeFuncName index ->

834 CallArg maybeFuncName index ->

800 let

835 let

801 thisFunction =

836 thisFunction =

802 case maybeFuncName of

837 case maybeFuncName of

803− NoName ->

804− "this function"

838+ NoName -> "this function"

805−

806− FuncName name ->

807− "`" <> N.toString name <> "`"

839+ FuncName name -> "`" <> N.toString name <> "`"

808−

809− CtorName name ->

810− "`" <> N.toString name <> "`"

840+ CtorName name -> "`" <> N.toString name <> "`"

811−

812− OpName op ->

813− "(" <> N.toString op <> ")"

841+ OpName op -> "(" <> N.toString op <> ")"

814−

815 in

842 in

816 Report.toCodeSnippet source region (Just exprRegion)

843 Report.toCodeSnippet source region (Just exprRegion)

817 (

844 (

compiler/src/Type/Constrain/Expression.hs+6−22

@@ -183,7 +183,7 @@ constrainLambda rtv region args body expected =

183

184

185constrainCall :: RTV -> R.Region -> Can.Expr -> [Can.Expr] -> Expected Type -> IO Constraint

186−constrainCall rtv region func args expected =

186+constrainCall rtv region func@(A.At funcRegion _) args expected =

187 do let maybeName = getName func

188

189 funcVar <- mkFlexVar

@@ -197,17 +197,15 @@ constrainCall rtv region func args expected =

197 unzip3 <$> Index.indexedTraverse (constrainArg rtv region maybeName) args

198

199 let arityType = foldr FunN resultType argTypes

200+ let category = CallResult maybeName

200− let resultCon = CEqual region (CallResult maybeName) resultType expected

201+ let resultCon = CEqual region category resultType expected

201

202

202 return $ exists (funcVar:resultVar:argVars) $

203 return $ exists (funcVar:resultVar:argVars) $

203 CAnd

204 CAnd

204 [ funcCon

205 [ funcCon

205− , CBranch

206+ , CEqual funcRegion category funcType (FromContext region (CallArity maybeName (length args)) arityType)

206− { _a = funcType

207− , _b = arityType

208− , _eq = CAnd [ CAnd argCons, resultCon ]

207+ , CAnd argCons

209− , _neq = constrainCallBackup rtv region maybeName func args

208+ , resultCon

210− }

211 ]

209 ]

212

210

213

211

@@ -219,20 +217,6 @@ constrainArg rtv region maybeName index arg =

219 return (argVar, argType, argCon)

217 return (argVar, argType, argCon)

220

218

221

219

222−constrainCallBackup :: RTV -> R.Region -> MaybeName -> Can.Expr -> [Can.Expr] -> IO Constraint

223−constrainCallBackup rtv region maybeName func args =

224− do (argVars, argTypes, argCons) <-

225− unzip3 <$> Index.indexedTraverse (constrainArg rtv region maybeName) args

226−

227− resultVar <- mkFlexVar

228− let resultType = VarN resultVar

229− let arityType = foldr FunN resultType argTypes

230−

231− funcCon <- constrain rtv func (FromContext region (TooManyArgs maybeName (length args)) arityType)

232−

233− return $ exists (resultVar:argVars) $ CAnd [ CAnd argCons, funcCon ]

234−

235−

236getName :: Can.Expr -> MaybeName

220getName :: Can.Expr -> MaybeName

237getName (A.At _ expr) =

221getName (A.At _ expr) =

238 case expr of

222 case expr of

compiler/src/Type/Solve.hs−13

@@ -142,19 +142,6 @@ solve env rank pools state constraint =

142 CAnd constraints ->

143 foldM (solve env rank pools) state constraints

144

145− CBranch a b eqCon makeNotEqCon ->

146− do aVar <- typeToVariable rank pools a

147− bVar <- typeToVariable rank pools b

148− answer <- Unify.unify aVar bVar

149− case answer of

150− Unify.Ok vars ->

151− do introduce rank pools vars

152− solve env rank pools state eqCon

153−

154− Unify.Err vars _ _ ->

155− do introduce rank pools vars

156− solve env rank pools state =<< makeNotEqCon

157−

158 CLet [] flexs _ headerCon CTrue ->

145 CLet [] flexs _ headerCon CTrue ->

159 do introduce rank pools flexs

146 do introduce rank pools flexs

160 solve env rank pools state headerCon

147 solve env rank pools state headerCon

compiler/src/Type/Type.hs−6

@@ -58,12 +58,6 @@ data Constraint

58 | CForeign R.Region N.Name Can.Annotation (E.Expected Type)

59 | CPattern R.Region E.PCategory Type (E.PExpected Type)

60 | CAnd [Constraint]

61− | CBranch

62− { _a :: Type

63− , _b :: Type

64− , _eq :: Constraint

65− , _neq :: IO Constraint

66− }

67 | CLet

61 | CLet

68 { _rigidVars :: [Variable]

62 { _rigidVars :: [Variable]

69 , _flexVars :: [Variable]

63 , _flexVars :: [Variable]