28a3095 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

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

Error earlier on argument count mismatch Removed unused error: DeprecatedRequirePath Fix error message for ExpectedType: print Type instead of *

commit28a3095be3144debc3396703ac173dcbf2ee7d6f authorLiam Goodacre <goodacre.liam@gmail.com> dateSat 14 Jan 2017, 00:34 (10 years ago) parentf2656f6

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

44import Prelude

examples/failing/TooFewClassInstanceArgs.pursnew file+8

@@ -0,0 +1,8 @@

1+-- @shouldFailWith ClassInstanceArityMismatch

2+module Main where

4+import Prelude

6+class Foo a b

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