@@ -53,6 +53,7 @@ addDataType moduleName dtype name args dctors ctorKind = do
5353addDataConstructor :: ModuleName -> DataDeclType -> ProperName -> [String] -> ProperName -> [Type] -> Check ()
5454addDataConstructor moduleName dtype name args dctor tys = do
5555 env <- getEnv
56+ mapM_ checkTypeSynonyms tys
5657 let retTy = foldl TypeApp (TypeConstructor (Qualified (Just moduleName) name)) (map TypeVar args)
5758 let dctorTy = foldr function retTy tys
5859 let polyType = mkForAll args dctorTy
@@ -61,6 +62,7 @@ addDataConstructor moduleName dtype name args dctor tys = do
6162addTypeSynonym :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> Type -> Kind -> Check ()
6263addTypeSynonym moduleName name args ty kind = do
6364 env <- getEnv
65+ checkTypeSynonyms ty
6466 putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, TypeSynonym) (types env)
6567 , typeSynonyms = M.insert (Qualified (Just moduleName) name) (args, ty) (typeSynonyms env) }
6668
@@ -106,6 +108,12 @@ checkTypeClassInstance _ (TypeConstructor ctor) = do
106108checkTypeClassInstance m (TypeApp t1 t2) = checkTypeClassInstance m t1 >> checkTypeClassInstance m t2
107109checkTypeClassInstance _ ty = throwError $ mkErrorStack "Type class instance head is invalid." (Just (TypeError ty))
108110
111+-- |
112+-- Check that type synonyms are fully-applied in a type
113+--
114+checkTypeSynonyms :: Type -> Check ()
115+checkTypeSynonyms = void . replaceAllTypeSynonyms
116+
109117-- |
110118-- Type check all declarations in a module
111119--