git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix #548
e9be955Phil Freeman
examples/failing/DuplicateTypeVars.pursnew file+3
compare with golang
unifiedsplit
@@ -0,0 +1,3 @@
1+module Main where
2+
3+type Foo a a = a
src/Language/PureScript/TypeChecker.hs+17−2
@@ -26,8 +26,11 @@ import Language.PureScript.TypeChecker.Types as T
26import Language.PureScript.TypeChecker.Synonyms as T
26import Language.PureScript.TypeChecker.Synonyms as T
27
27
28import Data.Maybe
28import Data.Maybe
29+import Data.List (nub, (\\))
29import Data.Monoid ((<>))
30import Data.Monoid ((<>))
31+import Data.Foldable (for_)
30import qualified Data.Map as M
32import qualified Data.Map as M
33+
31import Control.Monad.State
34import Control.Monad.State
32import Control.Monad.Error
35import Control.Monad.Error
33
36
@@ -87,6 +90,13 @@ addTypeClassDictionaries entries =
87 let mentries = M.fromList [ ((canonicalizeDictionary entry, mn), entry) | entry@TypeClassDictionaryInScope{ tcdName = Qualified mn _ } <- entries ]
90 let mentries = M.fromList [ ((canonicalizeDictionary entry, mn), entry) | entry@TypeClassDictionaryInScope{ tcdName = Qualified mn _ } <- entries ]
88 in modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = (typeClassDictionaries . checkEnv $ st) `M.union` mentries } }
91 in modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = (typeClassDictionaries . checkEnv $ st) `M.union` mentries } }
89
92
93+checkDuplicateTypeArguments :: [String] -> Check ()
94+checkDuplicateTypeArguments args = for_ firstDup $ \dup ->
95+ throwError . strMsg $ "Duplicate type argument '" ++ dup ++ "'"
96+ where
97+ firstDup :: Maybe String
98+ firstDup = listToMaybe $ args \\ nub args
99+
90checkTypeClassInstance :: ModuleName -> Type -> Check ()
100checkTypeClassInstance :: ModuleName -> Type -> Check ()
91checkTypeClassInstance _ (TypeVar _) = return ()
101checkTypeClassInstance _ (TypeVar _) = return ()
92checkTypeClassInstance _ (TypeConstructor ctor) = do
102checkTypeClassInstance _ (TypeConstructor ctor) = do
@@ -114,6 +124,7 @@ typeCheckAll _ _ [] = return []
114typeCheckAll mainModuleName moduleName (d@(DataDeclaration dtype name args dctors) : rest) = do
124typeCheckAll mainModuleName moduleName (d@(DataDeclaration dtype name args dctors) : rest) = do
115 rethrow (strMsg ("Error in type constructor " ++ show name) <>) $ do
125 rethrow (strMsg ("Error in type constructor " ++ show name) <>) $ do
116 when (dtype == Newtype) $ checkNewtype dctors
126 when (dtype == Newtype) $ checkNewtype dctors
127+ checkDuplicateTypeArguments args
117 ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)
128 ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)
118 addDataType moduleName dtype name args dctors ctorKind
129 addDataType moduleName dtype name args dctors ctorKind
119 ds <- typeCheckAll mainModuleName moduleName rest
130 ds <- typeCheckAll mainModuleName moduleName rest
@@ -128,9 +139,11 @@ typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : re
128 let syns = mapMaybe toTypeSynonym tys
139 let syns = mapMaybe toTypeSynonym tys
129 let dataDecls = mapMaybe toDataDecl tys
140 let dataDecls = mapMaybe toDataDecl tys
130 (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(_, name, args, dctors) -> (name, args, concatMap snd dctors)) dataDecls)
141 (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(_, name, args, dctors) -> (name, args, concatMap snd dctors)) dataDecls)
131− forM_ (zip dataDecls data_ks) $ \((dtype, name, args, dctors), ctorKind) ->
142+ forM_ (zip dataDecls data_ks) $ \((dtype, name, args, dctors), ctorKind) -> do
143+ checkDuplicateTypeArguments args
132 addDataType moduleName dtype name args dctors ctorKind
144 addDataType moduleName dtype name args dctors ctorKind
133− forM_ (zip syns syn_ks) $ \((name, args, ty), kind) ->
145+ forM_ (zip syns syn_ks) $ \((name, args, ty), kind) -> do
146+ checkDuplicateTypeArguments args
134 addTypeSynonym moduleName name args ty kind
147 addTypeSynonym moduleName name args ty kind
135 ds <- typeCheckAll mainModuleName moduleName rest
148 ds <- typeCheckAll mainModuleName moduleName rest
136 return $ d : ds
149 return $ d : ds
@@ -143,6 +156,7 @@ typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : re
143 toDataDecl _ = Nothing
156 toDataDecl _ = Nothing
144typeCheckAll mainModuleName moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do
157typeCheckAll mainModuleName moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do
145 rethrow (strMsg ("Error in type synonym " ++ show name) <>) $ do
158 rethrow (strMsg ("Error in type synonym " ++ show name) <>) $ do
159+ checkDuplicateTypeArguments args
146 kind <- kindsOf False moduleName name args [ty]
160 kind <- kindsOf False moduleName name args [ty]
147 addTypeSynonym moduleName name args ty kind
161 addTypeSynonym moduleName name args ty kind
148 ds <- typeCheckAll mainModuleName moduleName rest
162 ds <- typeCheckAll mainModuleName moduleName rest
@@ -213,3 +227,4 @@ typeCheckAll mainModuleName moduleName (PositionedDeclaration pos d : rest) =
213 rethrowWithPosition pos $ do
227 rethrowWithPosition pos $ do
214 (d' : rest') <- typeCheckAll mainModuleName moduleName (d : rest)
228 (d' : rest') <- typeCheckAll mainModuleName moduleName (d : rest)
215 return (PositionedDeclaration pos d' : rest')
229 return (PositionedDeclaration pos d' : rest')
230+