@@ -16,12 +16,16 @@ module Language.PureScript.Sugar.Names (
1616 rename
1717) where
1818
19−import Control.Applicative ((<$>), (<*>))
20−import Control.Monad (forM_, unless, foldM, liftM)
19+import Data.Maybe (fromMaybe)
2120import Data.Generics (extM, mkM, everywhereM)
2221import Data.List (intersect)
22+
23+import Control.Applicative ((<$>), (<*>))
24+import Control.Monad (forM_, unless, foldM, liftM)
25+
2326import qualified Data.Map as M
2427import qualified Data.Set as S
28+
2529import Language.PureScript.Declarations
2630import Language.PureScript.Names
2731import Language.PureScript.Types
@@ -175,13 +179,12 @@ findImports = foldl findImports' M.empty
175179
176180-- |
177181-- Constructs a local environment for a module.
178−-- TODO: check explicit imports actually exist
179182--
180183resolveImports :: ExportEnvironment -> Module -> Either String ImportEnvironment
181184resolveImports env (Module currentModule decls) = ImportEnvironment
182185 <$> resolve (exportedTypes env) (resolveDefs typeImports)
183186 <*> resolve (exportedDataConstructors env) resolveDcons
184− <*> resolve (exportedTypeClasses env) (resolveDefs classImports)
187+ <*> resolve (exportedTypeClasses env) (resolveDefs (const []))
185188 where
186189 -- A Map from module name to imports from that module, where Nothing indicates everything is to be imported
187190 scope :: M.Map ModuleName (Maybe ExplicitImports)
@@ -189,9 +192,9 @@ resolveImports env (Module currentModule decls) = ImportEnvironment
189192
190193 -- Resolve all exported names in a set by applying a type-specific resolver function
191194 resolve :: M.Map ModuleName (S.Set id) ->
192− (M.Map ProperName (Qualified ProperName) -> (ModuleName, S.Set id) -> Either String (M.Map ProperName (Qualified ProperName))) ->
195+ (M.Map ProperName (Qualified ProperName) -> ModuleName -> S.Set id -> Maybe ExplicitImports -> Either String (M.Map ProperName (Qualified ProperName))) ->
193196 Either String (M.Map ProperName (Qualified ProperName))
194− resolve m f = foldM f M.empty (M.toList m)
197+ resolve m f = foldM (\m' (mn, maybeExpl) -> f m' mn (fromMaybe S.empty $ mn `M.lookup` m) maybeExpl) M.empty (M.toList scope)
195198
196199 -- Resolve a single name by adding it to the Map with a specified ModuleName, checking first
197200 -- that the name does not currently exist in scope.
@@ -211,22 +214,26 @@ resolveImports env (Module currentModule decls) = ImportEnvironment
211214 -- its first argument
212215 resolveDefs :: (ExplicitImports -> [ProperName]) ->
213216 M.Map ProperName (Qualified ProperName) ->
214− (ModuleName, S.Set ProperName) ->
217+ ModuleName ->
218+ S.Set ProperName ->
219+ Maybe ExplicitImports ->
215220 Either String (M.Map ProperName (Qualified ProperName))
216− resolveDefs filt result (mn, names) = case M.lookup mn scope of
217− Just maybeExpl -> foldM (resolveDef mn) result $
218− case maybeExpl of
219− Just expl -> S.toList names `intersect` filt expl
220− Nothing -> S.toList names
221− Nothing -> Right result
221+ resolveDefs filt result mn names maybeExpl = do
222+ names' <- case maybeExpl of
223+ Just expl -> do
224+ forM_ (filt expl) $ \name ->
225+ unless (name `S.member` names) $ Left $ show name ++ " is explictly imported but is not defined in module " ++ show mn
226+ return $ S.toList names `intersect` filt expl
227+ Nothing -> return $ S.toList names
228+ foldM (resolveDef mn) result names'
222229
223230 -- Resolve a set of data constructors keyed by their type constructor
224231 resolveDcons :: M.Map ProperName (Qualified ProperName) ->
225− (ModuleName, S.Set (ProperName, [ProperName])) ->
232+ ModuleName ->
233+ S.Set (ProperName, [ProperName]) ->
234+ Maybe ExplicitImports ->
226235 Either String (M.Map ProperName (Qualified ProperName))
227− resolveDcons result (mn, tcons) = case M.lookup mn scope of
228− Just maybeExpl -> foldM (foldM $ resolveDef mn) result $ map snd $
229− case maybeExpl of
230− Just expl -> filter ((`elem` typeImports expl) . fst) (S.toList tcons)
231− Nothing -> S.toList tcons
232− Nothing -> Right result
236+ resolveDcons result mn tcons maybeExpl = foldM (foldM $ resolveDef mn) result $ map snd $
237+ case maybeExpl of
238+ Just expl -> filter ((`elem` typeImports expl) . fst) (S.toList tcons)
239+ Nothing -> S.toList tcons