git.iko.soy/elk
on master help sign in
Produce better error messages on "too many args"

Kind of simplifies things because the CBranch idea goes away. It was kind of weird and it appears that it was causing some sort of crash anyway.

commit66b67260bdee900e6825edf7e32daba1e6a8f3a8 authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 2 Apr 2018, 16:14 (9 years ago) parenta84f4bd
4 files changed+45−53
compare with master
unifiedsplit
compiler/src/Reporting/Error/Type.hs+39−12 compiler/src/Type/Constrain/Expression.hs+6−22 compiler/src/Type/Solve.hs−13 compiler/src/Type/Type.hs−6
compiler/src/Reporting/Error/Type.hs+39−12
@@ -60,6 +60,7 @@ data Context
6060 | IfCondition
6161 | IfBranch Index.ZeroBased
6262 | CaseBranch Index.ZeroBased
63+ | CallArity MaybeName Int
6364 | CallArg MaybeName Index.ZeroBased
6465 | TooManyArgs MaybeName Int
6566 | RecordAccess N.Name
@@ -796,22 +797,48 @@ toExprReport source localizer exprRegion category tipe expected =
796797 )
797798 )
798799
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+
799834 CallArg maybeFuncName index ->
800835 let
801836 thisFunction =
802837 case maybeFuncName of
803− NoName ->
804− "this function"
805−
806− FuncName name ->
807− "`" <> N.toString name <> "`"
808−
809− CtorName name ->
810− "`" <> N.toString name <> "`"
811−
812− OpName op ->
813− "(" <> N.toString op <> ")"
814−
838+ NoName -> "this function"
839+ FuncName name -> "`" <> N.toString name <> "`"
840+ CtorName name -> "`" <> N.toString name <> "`"
841+ OpName op -> "(" <> N.toString op <> ")"
815842 in
816843 Report.toCodeSnippet source region (Just exprRegion)
817844 (
compiler/src/Type/Constrain/Expression.hs+6−22
@@ -183,7 +183,7 @@ constrainLambda rtv region args body expected =
183183
184184
185185constrainCall :: 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 =
187187 do let maybeName = getName func
188188
189189 funcVar <- mkFlexVar
@@ -197,17 +197,15 @@ constrainCall rtv region func args expected =
197197 unzip3 <$> Index.indexedTraverse (constrainArg rtv region maybeName) args
198198
199199 let arityType = foldr FunN resultType argTypes
200− let resultCon = CEqual region (CallResult maybeName) resultType expected
200+ let category = CallResult maybeName
201+ let resultCon = CEqual region category resultType expected
201202
202203 return $ exists (funcVar:resultVar:argVars) $
203204 CAnd
204205 [ funcCon
205− , CBranch
206− { _a = funcType
207− , _b = arityType
208− , _eq = CAnd [ CAnd argCons, resultCon ]
209− , _neq = constrainCallBackup rtv region maybeName func args
210− }
206+ , CEqual funcRegion category funcType (FromContext region (CallArity maybeName (length args)) arityType)
207+ , CAnd argCons
208+ , resultCon
211209 ]
212210
213211
@@ -219,20 +217,6 @@ constrainArg rtv region maybeName index arg =
219217 return (argVar, argType, argCon)
220218
221219
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−
236220getName :: Can.Expr -> MaybeName
237221getName (A.At _ expr) =
238222 case expr of
compiler/src/Type/Solve.hs−13
@@ -142,19 +142,6 @@ solve env rank pools state constraint =
142142 CAnd constraints ->
143143 foldM (solve env rank pools) state constraints
144144
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−
158145 CLet [] flexs _ headerCon CTrue ->
159146 do introduce rank pools flexs
160147 solve env rank pools state headerCon
compiler/src/Type/Type.hs−6
@@ -58,12 +58,6 @@ data Constraint
5858 | CForeign R.Region N.Name Can.Annotation (E.Expected Type)
5959 | CPattern R.Region E.PCategory Type (E.PExpected Type)
6060 | CAnd [Constraint]
61− | CBranch
62− { _a :: Type
63− , _b :: Type
64− , _eq :: Constraint
65− , _neq :: IO Constraint
66− }
6761 | CLet
6862 { _rigidVars :: [Variable]
6963 , _flexVars :: [Variable]