git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #722 from purescript/694-take-2
beebdc2Phil Freeman
examples/failing/TypeSynonyms4.pursnew file+8
compare with golang
unifiedsplit
@@ -0,0 +1,8 @@
1+module TypeSynonyms4 where
2+
3+type F x y = x -> y
4+
5+type G x = F x
6+
7+f :: G String String -> String
8+f k = k "Done"
src/Language/PureScript/TypeChecker.hs+8
@@ -53,6 +53,7 @@ addDataType moduleName dtype name args dctors ctorKind = do
53addDataConstructor :: ModuleName -> DataDeclType -> ProperName -> [String] -> ProperName -> [Type] -> Check ()
53addDataConstructor :: ModuleName -> DataDeclType -> ProperName -> [String] -> ProperName -> [Type] -> Check ()
54addDataConstructor moduleName dtype name args dctor tys = do
54addDataConstructor moduleName dtype name args dctor tys = do
55 env <- getEnv
55 env <- getEnv
56+ mapM_ checkTypeSynonyms tys
56 let retTy = foldl TypeApp (TypeConstructor (Qualified (Just moduleName) name)) (map TypeVar args)
57 let retTy = foldl TypeApp (TypeConstructor (Qualified (Just moduleName) name)) (map TypeVar args)
57 let dctorTy = foldr function retTy tys
58 let dctorTy = foldr function retTy tys
58 let polyType = mkForAll args dctorTy
59 let polyType = mkForAll args dctorTy
@@ -61,6 +62,7 @@ addDataConstructor moduleName dtype name args dctor tys = do
61addTypeSynonym :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> Type -> Kind -> Check ()
62addTypeSynonym :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> Type -> Kind -> Check ()
62addTypeSynonym moduleName name args ty kind = do
63addTypeSynonym moduleName name args ty kind = do
63 env <- getEnv
64 env <- getEnv
65+ checkTypeSynonyms ty
64 putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, TypeSynonym) (types env)
66 putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, TypeSynonym) (types env)
65 , typeSynonyms = M.insert (Qualified (Just moduleName) name) (args, ty) (typeSynonyms env) }
67 , typeSynonyms = M.insert (Qualified (Just moduleName) name) (args, ty) (typeSynonyms env) }
66
68
@@ -106,6 +108,12 @@ checkTypeClassInstance _ (TypeConstructor ctor) = do
106checkTypeClassInstance m (TypeApp t1 t2) = checkTypeClassInstance m t1 >> checkTypeClassInstance m t2
108checkTypeClassInstance m (TypeApp t1 t2) = checkTypeClassInstance m t1 >> checkTypeClassInstance m t2
107checkTypeClassInstance _ ty = throwError $ mkErrorStack "Type class instance head is invalid." (Just (TypeError ty))
109checkTypeClassInstance _ ty = throwError $ mkErrorStack "Type class instance head is invalid." (Just (TypeError ty))
108
110
111+-- |
112+-- Check that type synonyms are fully-applied in a type
113+--
114+checkTypeSynonyms :: Type -> Check ()
115+checkTypeSynonyms = void . replaceAllTypeSynonyms
116+
109-- |
117-- |
110-- Type check all declarations in a module
118-- Type check all declarations in a module
111--
119--