@@ -24,6 +24,7 @@
2424module Language.PureScript.TypeChecker.Monad where
2525
2626import Data.Maybe
27+import Data.Foldable (for_)
2728import qualified Data.Map as M
2829
2930#if __GLASGOW_HASKELL__ < 710
@@ -67,8 +68,13 @@ bindTypes newNames action = do
6768-- |
6869-- Temporarily bind a collection of names to types
6970--
70−withScopedTypeVars :: (Functor m, MonadState CheckState m) => ModuleName -> [(String, Kind)] -> m a -> m a
71−withScopedTypeVars mn ks = bindTypes (M.fromList (map (\(name, k) -> (Qualified (Just mn) (ProperName name), (k, ScopedTypeVar))) ks))
71+withScopedTypeVars :: (Functor m, Applicative m, MonadState CheckState m, MonadWriter MultipleErrors m) => ModuleName -> [(String, Kind)] -> m a -> m a
72+withScopedTypeVars mn ks ma = do
73+ orig <- get
74+ for_ ks $ \(name, _) ->
75+ when (Qualified (Just mn) (ProperName name) `M.member` types (checkEnv orig)) $
76+ tell . errorMessage $ ShadowedTypeVar name
77+ bindTypes (M.fromList (map (\(name, k) -> (Qualified (Just mn) (ProperName name), (k, ScopedTypeVar))) ks)) ma
7278
7379-- |
7480-- Temporarily make a collection of type class dictionaries available