git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Disallow type synonym instances #177
commit554c9a009be0a304c72cd731b0cfd77455d31eef authorPhil Freeman <paf31@cantab.net> dateFri 7 Feb 2014, 10:39 (13 years ago) parentd8d0f54
3 files changed+33
compare with golang
unifiedsplit
examples/failing/TypeSynonyms2.purs+9 examples/failing/TypeSynonyms3.purs+13 src/Language/PureScript/TypeChecker.hs+11
examples/failing/TypeSynonyms2.pursnew file+9
@@ -0,0 +1,9 @@
1+module TypeSynonyms2 where
2+
3+class Foo a where
4+ foo :: a -> String
5+
6+type Bar = String
7+
8+instance Foo Bar where
9+ foo s = s
examples/failing/TypeSynonyms3.pursnew file+13
@@ -0,0 +1,13 @@
1+module TypeSynonyms2 where
2+
3+class Foo a where
4+ foo :: a -> String
5+
6+type Bar = String
7+
8+module M where
9+
10+import TypeSynonyms2
11+
12+instance TypeSynonyms2.Foo Bar where
13+ foo s = s
src/Language/PureScript/TypeChecker.hs+11
@@ -90,6 +90,15 @@ addTypeClassDictionaries :: [TypeClassDictionaryInScope] -> Check ()
9090addTypeClassDictionaries entries = do
9191 modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = entries ++ (typeClassDictionaries . checkEnv $ st) } }
9292
93+checkTypeClassInstance :: ModuleName -> Type -> Check ()
94+checkTypeClassInstance _ (TypeVar _) = return ()
95+checkTypeClassInstance m (TypeConstructor ctor) = do
96+ env <- getEnv
97+ when (canonicalizeType m env ctor `M.member` typeSynonyms env) $ throwError "Type synonym instances are disallowed"
98+ return ()
99+checkTypeClassInstance m (TypeApp ty (TypeVar _)) = checkTypeClassInstance m ty
100+checkTypeClassInstance _ _ = throwError "Type class instance must be of the form T a1 ... an"
101+
93102-- |
94103-- Type check all declarations in a module
95104--
@@ -242,6 +251,8 @@ typeCheckAll moduleName (d@(TypeClassDeclaration _ _ _) : rest) = do
242251typeCheckAll moduleName (d@(TypeInstanceDeclaration deps className ty _) : rest) = do
243252 env <- getEnv
244253 dictName <- Check . lift $ mkDictionaryValueName moduleName className ty
254+ checkTypeClassInstance moduleName ty
255+ forM_ deps $ checkTypeClassInstance moduleName . snd
245256 addTypeClassDictionaries (qualifyAllUnqualifiedNames moduleName env
246257 [TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className ty (Just deps) TCDRegular])
247258 ds <- typeCheckAll moduleName rest