@@ -26,8 +26,11 @@ import Language.PureScript.TypeChecker.Types as T
2626import Language.PureScript.TypeChecker.Synonyms as T
2727
2828import Data.Maybe
29+import Data.List (nub, (\\))
2930import Data.Monoid ((<>))
31+import Data.Foldable (for_)
3032import qualified Data.Map as M
33+
3134import Control.Monad.State
3235import Control.Monad.Error
3336
@@ -87,6 +90,13 @@ addTypeClassDictionaries entries =
8790 let mentries = M.fromList [ ((canonicalizeDictionary entry, mn), entry) | entry@TypeClassDictionaryInScope{ tcdName = Qualified mn _ } <- entries ]
8891 in modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = (typeClassDictionaries . checkEnv $ st) `M.union` mentries } }
8992
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+
90100checkTypeClassInstance :: ModuleName -> Type -> Check ()
91101checkTypeClassInstance _ (TypeVar _) = return ()
92102checkTypeClassInstance _ (TypeConstructor ctor) = do
@@ -114,6 +124,7 @@ typeCheckAll _ _ [] = return []
114124typeCheckAll mainModuleName moduleName (d@(DataDeclaration dtype name args dctors) : rest) = do
115125 rethrow (strMsg ("Error in type constructor " ++ show name) <>) $ do
116126 when (dtype == Newtype) $ checkNewtype dctors
127+ checkDuplicateTypeArguments args
117128 ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)
118129 addDataType moduleName dtype name args dctors ctorKind
119130 ds <- typeCheckAll mainModuleName moduleName rest
@@ -128,9 +139,11 @@ typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : re
128139 let syns = mapMaybe toTypeSynonym tys
129140 let dataDecls = mapMaybe toDataDecl tys
130141 (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
132144 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
134147 addTypeSynonym moduleName name args ty kind
135148 ds <- typeCheckAll mainModuleName moduleName rest
136149 return $ d : ds
@@ -143,6 +156,7 @@ typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : re
143156 toDataDecl _ = Nothing
144157typeCheckAll mainModuleName moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do
145158 rethrow (strMsg ("Error in type synonym " ++ show name) <>) $ do
159+ checkDuplicateTypeArguments args
146160 kind <- kindsOf False moduleName name args [ty]
147161 addTypeSynonym moduleName name args ty kind
148162 ds <- typeCheckAll mainModuleName moduleName rest
@@ -213,3 +227,4 @@ typeCheckAll mainModuleName moduleName (PositionedDeclaration pos d : rest) =
213227 rethrowWithPosition pos $ do
214228 (d' : rest') <- typeCheckAll mainModuleName moduleName (d : rest)
215229 return (PositionedDeclaration pos d' : rest')
230+