git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #2563 from LiamGoodacre/fix/class-instance-arity

Fix 'Unknown type index' on mismatch between class and instance argument counts

commit15f251caa5c64c5f0c027a337887c3f91cf879d6 authorPhil Freeman <paf31@cantab.net> dateSat 14 Jan 2017, 12:07 (10 years ago) parentf2656f628a3095
5 files changed+28−7
compare with golang
unifiedsplit
examples/failing/MPTCs.purs+1−1 examples/failing/TooFewClassInstanceArgs.purs+8 src/Language/PureScript/AST/Declarations.hs+2−1 src/Language/PureScript/Errors.hs+9−5 src/Language/PureScript/TypeChecker.hs+8
examples/failing/MPTCs.purs+1−1
@@ -1,4 +1,4 @@
1−-- @shouldFailWith KindsDoNotUnify
1+-- @shouldFailWith ClassInstanceArityMismatch
22module Main where
33
44import Prelude
examples/failing/TooFewClassInstanceArgs.pursnew file+8
@@ -0,0 +1,8 @@
1+-- @shouldFailWith ClassInstanceArityMismatch
2+module Main where
3+
4+import Prelude
5+
6+class Foo a b
7+
8+instance fooString :: Foo String
src/Language/PureScript/AST/Declarations.hs+2−1
@@ -134,11 +134,12 @@ data SimpleErrorMessage
134134 | CaseBinderLengthDiffers Int [Binder]
135135 | IncorrectAnonymousArgument
136136 | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)
137− | DeprecatedRequirePath
138137 | CannotGeneralizeRecursiveFunction Ident Type
139138 | CannotDeriveNewtypeForData (ProperName 'TypeName)
140139 | ExpectedWildcard (ProperName 'TypeName)
141140 | CannotUseBindWithDo
141+ -- | instance name, type class, expected argument count, actual argument count
142+ | ClassInstanceArityMismatch Ident (Qualified (ProperName 'ClassName)) Int Int
142143 deriving (Show)
143144
144145-- | Error message hints, providing more detailed information about failure.
src/Language/PureScript/Errors.hs+9−5
@@ -168,11 +168,11 @@ errorCode em = case unwrapErrorMessage em of
168168 CaseBinderLengthDiffers{} -> "CaseBinderLengthDiffers"
169169 IncorrectAnonymousArgument -> "IncorrectAnonymousArgument"
170170 InvalidOperatorInBinder{} -> "InvalidOperatorInBinder"
171− DeprecatedRequirePath{} -> "DeprecatedRequirePath"
172171 CannotGeneralizeRecursiveFunction{} -> "CannotGeneralizeRecursiveFunction"
173172 CannotDeriveNewtypeForData{} -> "CannotDeriveNewtypeForData"
174173 ExpectedWildcard{} -> "ExpectedWildcard"
175174 CannotUseBindWithDo{} -> "CannotUseBindWithDo"
175+ ClassInstanceArityMismatch{} -> "ClassInstanceArityMismatch"
176176
177177-- |
178178-- A stack trace for an error
@@ -691,7 +691,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalS
691691 renderSimpleErrorMessage (ExtraneousClassMember ident className) =
692692 line $ "" <> markCode (showIdent ident) <> " is not a member of type class " <> markCode (showQualified runProperName className)
693693 renderSimpleErrorMessage (ExpectedType ty kind) =
694− paras [ line $ "In a type-annotated expression " <> markCode "x :: t" <> ", the type " <> markCode "t" <> " must have kind " <> markCode "*" <> "."
694+ paras [ line $ "In a type-annotated expression " <> markCode "x :: t" <> ", the type " <> markCode "t" <> " must have kind " <> markCode (prettyPrintKind kindType) <> "."
695695 , line "The error arises from the type"
696696 , markCodeBox $ indent $ typeAsBox ty
697697 , line "having the kind"
@@ -863,9 +863,6 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalS
863863 , line "Only aliases for data constructors may be used in patterns."
864864 ]
865865
866− renderSimpleErrorMessage DeprecatedRequirePath =
867− line "The require-path option is deprecated and will be removed in PureScript 0.9."
868−
869866 renderSimpleErrorMessage (CannotGeneralizeRecursiveFunction ident ty) =
870867 paras [ line $ "Unable to generalize the type of the recursive function " <> markCode (showIdent ident) <> "."
871868 , line $ "The inferred type of " <> markCode (showIdent ident) <> " was:"
@@ -885,6 +882,13 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalS
885882 paras [ line $ "The name " <> markCode "bind" <> " cannot be brought into scope in a do notation block, since do notation uses the same name."
886883 ]
887884
885+ renderSimpleErrorMessage (ClassInstanceArityMismatch dictName className expected actual) =
886+ paras [ line $ "The type class " <> markCode (showQualified runProperName className) <>
887+ " expects " <> T.pack (show expected) <> " argument(s)."
888+ , line $ "But the instance " <> markCode (showIdent dictName) <> " only provided " <>
889+ T.pack (show actual) <> "."
890+ ]
891+
888892 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box
889893 renderHint (ErrorUnifyingTypes t1 t2) detail =
890894 paras [ detail
src/Language/PureScript/TypeChecker.hs+8
@@ -297,6 +297,7 @@ typeCheckAll moduleName _ = traverse go
297297 case M.lookup className (typeClasses env) of
298298 Nothing -> internalError "typeCheckAll: Encountered unknown type class in instance declaration"
299299 Just typeClass -> do
300+ checkInstanceArity dictName className typeClass tys
300301 sequence_ (zipWith (checkTypeClassInstance typeClass) [0..] tys)
301302 checkOrphanInstance dictName className typeClass tys
302303 _ <- traverseTypeInstanceBody checkInstanceMembers body
@@ -306,6 +307,13 @@ typeCheckAll moduleName _ = traverse go
306307 go (PositionedDeclaration pos com d) =
307308 warnAndRethrowWithPosition pos $ PositionedDeclaration pos com <$> go d
308309
310+ checkInstanceArity :: Ident -> Qualified (ProperName 'ClassName) -> TypeClassData -> [Type] -> m ()
311+ checkInstanceArity dictName className typeClass tys = do
312+ let typeClassArity = length (typeClassArguments typeClass)
313+ instanceArity = length tys
314+ when (typeClassArity /= instanceArity) $
315+ throwError . errorMessage $ ClassInstanceArityMismatch dictName className typeClassArity instanceArity
316+
309317 checkInstanceMembers :: [Declaration] -> m [Declaration]
310318 checkInstanceMembers instDecls = do
311319 let idents = sort . map head . group . map memberName $ instDecls