git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix type synonyms when checking
1e6bac6Phil Freeman
src/Language/PureScript/TypeChecker/Types.hs+13−5
compare with golang
unifiedsplit
@@ -18,6 +18,8 @@ module Language.PureScript.TypeChecker.Types (
18 typeOf
18 typeOf
19) where
19) where
20
20
21+import Debug.Trace
22+
21import Data.List
23import Data.List
22import Data.Maybe (fromMaybe)
24import Data.Maybe (fromMaybe)
23import Data.Function
25import Data.Function
@@ -361,7 +363,7 @@ infer m v@(Constructor c) = do
361 modulePath <- checkModulePath `fmap` lift get
363 modulePath <- checkModulePath `fmap` lift get
362 case M.lookup (qualify modulePath c) (dataConstructors env) of
364 case M.lookup (qualify modulePath c) (dataConstructors env) of
363 Nothing -> throwError $ "Constructor " ++ show c ++ " is undefined"
365 Nothing -> throwError $ "Constructor " ++ show c ++ " is undefined"
364− Just ty -> return ty
366+ Just ty -> lift $ replaceAllTypeSynonyms ty
365infer m (Case val binders) = do
367infer m (Case val binders) = do
366 t1 <- infer m val
368 t1 <- infer m val
367 ret <- fresh
369 ret <- fresh
@@ -377,7 +379,7 @@ infer m v@(TypedValue val ty) = do
377 kind <- lift $ kindOf ty
379 kind <- lift $ kindOf ty
378 guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
380 guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
379 ty' <- lift $ replaceAllTypeSynonyms ty
381 ty' <- lift $ replaceAllTypeSynonyms ty
380− check m val ty'
382+ trace (prettyPrintType ty') $ check m val ty'
381 return ty'
383 return ty'
382
384
383inferUnary :: UnaryOperator -> Type -> Subst Check Type
385inferUnary :: UnaryOperator -> Type -> Subst Check Type
@@ -619,7 +621,9 @@ check m v@(Var var@(Qualified mp name)) ty = do
619 case mp of
621 case mp of
620 ModulePath [] ->
622 ModulePath [] ->
621 case M.lookup name m of
623 case M.lookup name m of
624+ Just ty1 -> do
625+ repl <- lift $ replaceAllTypeSynonyms ty1
622− Just ty1 -> ty1 `subsumes` ty
626+ repl `subsumes` ty
623 Nothing -> lookupGlobal
627 Nothing -> lookupGlobal
624 _ -> lookupGlobal
628 _ -> lookupGlobal
625 where
629 where
@@ -628,7 +632,9 @@ check m v@(Var var@(Qualified mp name)) ty = do
628 modulePath <- checkModulePath `fmap` lift get
632 modulePath <- checkModulePath `fmap` lift get
629 case M.lookup (qualify modulePath var) (names env) of
633 case M.lookup (qualify modulePath var) (names env) of
630 Nothing -> throwError $ show var ++ " is undefined"
634 Nothing -> throwError $ show var ++ " is undefined"
635+ Just (ty1, _) -> do
636+ repl <- lift $ replaceAllTypeSynonyms ty1
631− Just (ty1, _) -> ty1 `subsumes` ty
637+ repl `subsumes` ty
632check m val u@(TUnknown _) = do
638check m val u@(TUnknown _) = do
633 ty <- infer m val
639 ty <- infer m val
634 ty ~~ u
640 ty ~~ u
@@ -663,7 +669,9 @@ check m (Constructor c) ty = do
663 modulePath <- checkModulePath `fmap` lift get
669 modulePath <- checkModulePath `fmap` lift get
664 case M.lookup (qualify modulePath c) (dataConstructors env) of
670 case M.lookup (qualify modulePath c) (dataConstructors env) of
665 Nothing -> throwError $ "Constructor " ++ show c ++ " is undefined"
671 Nothing -> throwError $ "Constructor " ++ show c ++ " is undefined"
672+ Just ty1 -> do
673+ repl <- lift $ replaceAllTypeSynonyms ty1
666− Just ty1 -> ty1 `subsumes` ty
674+ repl `subsumes` ty
667check m val (SaturatedTypeSynonym name args) = do
675check m val (SaturatedTypeSynonym name args) = do
668 env <- lift getEnv
676 env <- lift getEnv
669 modulePath <- checkModulePath `fmap` lift get
677 modulePath <- checkModulePath `fmap` lift get