@@ -27,7 +27,6 @@ import Control.Monad (foldM)
2727import Control.Monad.Error
2828
2929import qualified Data.Map as M
30−import qualified Data.Set as S
3130
3231import Language.PureScript.Declarations
3332import Language.PureScript.Names
@@ -47,14 +46,14 @@ data Exports = Exports
4746 -- |
4847 -- The types exported from each module
4948 --
50− { exportedTypes :: S.Set (ProperName, [ProperName])
49+ { exportedTypes :: [(ProperName, [ProperName])]
5150 -- |
5251 -- The classes exported from each module
5352 --
54− , exportedTypeClasses :: S.Set ProperName
53+ , exportedTypeClasses :: [ProperName]
5554 -- |
5655 -- The values exported from each module
57− , exportedValues :: S.Set Ident
56+ , exportedValues :: [Ident]
5857 --
5958 } deriving (Show)
6059
@@ -94,7 +93,7 @@ updateExportedModule env mn update = do
9493-- Adds an empty module to an ExportEnvironment.
9594--
9695addEmptyModule :: ExportEnvironment -> ModuleName -> ExportEnvironment
97−addEmptyModule env name = M.insert name (Exports S.empty S.empty S.empty) env
96+addEmptyModule env name = M.insert name (Exports [] [] []) env
9897
9998-- |
10099-- Adds a type belonging to a module to the export environment.
@@ -121,13 +120,14 @@ addValue env mn name = updateExportedModule env mn $ \m -> do
121120 return $ m { exportedValues = values }
122121
123122-- |
124−-- Adds an export to a map of exports of that type.
123+-- Adds an entry to a list of exports unless it is already present, in which case an error is
124+-- returned.
125125--
126−addExport :: (Ord s, Show s) => S.Set s -> s -> Either String (S.Set s)
126+addExport :: (Eq a, Show a) => [a] -> a -> Either String [a]
127127addExport exports name =
128− if S.member name exports
128+ if name `elem` exports
129129 then throwError $ "Multiple definitions for '" ++ show name ++ "'"
130− else return $ S.insert name exports
130+ else return $ name : exports
131131
132132-- |
133133-- Replaces all local names with qualified names within a set of modules.
@@ -184,14 +184,14 @@ renameInModule imports exports (Module mn decls exps) =
184184 updateTypeName (Qualified Nothing name) = update "type" importedTypes name
185185 updateTypeName (Qualified (Just mn) name) = do
186186 modExports <- getExports mn
187− case name `lookup` S.toList (exportedTypes modExports) of
187+ case name `lookup` exportedTypes modExports of
188188 Nothing -> throwError $ "Unknown type '" ++ show (Qualified (Just mn) name) ++ "'"
189189 _ -> return $ Qualified (Just mn) name
190190
191191 updateDataConstructorName (Qualified Nothing name) = update "data constructor" importedDataConstructors name
192192 updateDataConstructorName (Qualified (Just mn) name) = do
193193 modExports <- getExports mn
194− let allDcons = join $ snd `map` S.toList (exportedTypes modExports)
194+ let allDcons = join $ snd `map` exportedTypes modExports
195195 if name `elem` allDcons
196196 then return $ Qualified (Just mn) name
197197 else throwError $ "Unknown data constructor '" ++ show (Qualified (Just mn) name) ++ "'"
@@ -203,14 +203,14 @@ renameInModule imports exports (Module mn decls exps) =
203203 updateValueName (Qualified (Just mn) name) = check "value" exportedValues mn name
204204
205205 -- Replace an unqualified name with a qualified
206− update :: (Show a, Ord a) => String -> (ImportEnvironment -> M.Map a (Qualified a)) -> a -> Either String (Qualified a)
206+ update :: (Ord a, Show a) => String -> (ImportEnvironment -> M.Map a (Qualified a)) -> a -> Either String (Qualified a)
207207 update t get name = maybe (throwError $ "Unknown " ++ t ++ " '" ++ show name ++ "'") return $ M.lookup name (get imports)
208208
209209 -- Check that a qualified name is valid
210− check :: (Show a, Ord a) => String -> (Exports -> S.Set a) -> ModuleName -> a -> Either String (Qualified a)
210+ check :: (Show a, Eq a) => String -> (Exports -> [a]) -> ModuleName -> a -> Either String (Qualified a)
211211 check t get mn name = do
212212 modExports <- getExports mn
213− if name `S.member` get modExports
213+ if name `elem` get modExports
214214 then return $ Qualified (Just mn) name
215215 else throwError $ "Unknown " ++ t ++ " '" ++ show (Qualified (Just mn) name) ++ "'"
216216
@@ -226,7 +226,9 @@ findExports = foldM addModule $ M.singleton (ModuleName [ProperName "Prim"]) pri
226226 where
227227
228228 -- The exported types from the Prim module
229− primExports = Exports (S.fromList $ (\(Qualified _ name) -> (name, [])) `map` M.keys primTypes) S.empty S.empty
229+ primExports = Exports (mkTypeEntry `map` M.keys primTypes) [] []
230+ where
231+ mkTypeEntry (Qualified _ name) = (name, [])
230232
231233 -- Add all of the exported declarations from a module to the global export environment
232234 addModule :: ExportEnvironment -> Module -> Either String ExportEnvironment
@@ -261,18 +263,18 @@ filterExports mn exps env = do
261263 -- Filter the exports for the specific module
262264 filterModule :: [DeclarationRef] -> Exports -> Either String Exports
263265 filterModule exps exported = do
264− types <- foldM (filterTypes $ S.toList $ exportedTypes exported) S.empty exps
265− values <- foldM (filterValues $ exportedValues exported) S.empty exps
266− classes <- foldM (filterClasses $ exportedTypeClasses exported) S.empty exps
266+ types <- foldM (filterTypes $ exportedTypes exported) [] exps
267+ values <- foldM (filterValues $ exportedValues exported) [] exps
268+ classes <- foldM (filterClasses $ exportedTypeClasses exported) [] exps
267269 return exported { exportedTypes = types, exportedTypeClasses = classes, exportedValues = values }
268270
269271 -- Ensure the exported types and data constructors exist in the module and add them to the set of
270272 -- exports
271− filterTypes :: [(ProperName, [ProperName])] -> S.Set (ProperName, [ProperName]) -> DeclarationRef -> Either String (S.Set (ProperName, [ProperName]))
273+ filterTypes :: [(ProperName, [ProperName])] -> [(ProperName, [ProperName])] -> DeclarationRef -> Either String [(ProperName, [ProperName])]
272274 filterTypes exps result (TypeRef name expDcons) = do
273275 dcons <- maybe (throwError $ "Cannot export undefined type '" ++ show name ++ "'") return $ name `lookup` exps
274276 dcons' <- maybe (return dcons) (foldM (filterDcons name dcons) []) expDcons
275− return $ S.insert (name, dcons') result
277+ return $ (name, dcons') : result
276278 filterTypes exps result _ = return result
277279
278280 -- Ensure the exported data constructors exists for a type and add them to the list of exports
@@ -283,18 +285,18 @@ filterExports mn exps env = do
283285 else throwError $ "Cannot export undefined data constructor '" ++ show name ++ "' for type '" ++ show tcon ++ "'"
284286
285287 -- Ensure the exported classes exist in the module and add them to the set of exports
286− filterClasses :: S.Set ProperName -> S.Set ProperName -> DeclarationRef -> Either String (S.Set ProperName)
288+ filterClasses :: [ProperName] -> [ProperName] -> DeclarationRef -> Either String [ProperName]
287289 filterClasses exps result (TypeClassRef name) =
288− if name `S.member` exps
289− then return $ S.insert name result
290+ if name `elem` exps
291+ then return $ name : result
290292 else throwError $ "Cannot export undefined type class '" ++ show name ++ "'"
291293 filterClasses exps result _ = return result
292294
293295 -- Ensure the exported values exist in the module and add them to the set of exports
294− filterValues :: S.Set Ident -> S.Set Ident -> DeclarationRef -> Either String (S.Set Ident)
296+ filterValues :: [Ident] -> [Ident] -> DeclarationRef -> Either String [Ident]
295297 filterValues exps result (ValueRef name) =
296− if name `S.member` exps
297− then return $ S.insert name result
298+ if name `elem` exps
299+ then return $ name : result
298300 else throwError $ "Cannot export undefined value '" ++ show name ++ "'"
299301 filterValues exps result _ = return result
300302
@@ -339,9 +341,9 @@ resolveImport currentModule importModule exp imp i = case i of
339341 -- Import everything from a module
340342 importAll :: ImportEnvironment -> Either String ImportEnvironment
341343 importAll imp = do
342− imp' <- foldM (\m (name, dctors) -> importExplicit m (TypeRef name (Just dctors))) imp (S.toList $ exportedTypes exp)
343− imp'' <- foldM (\m name -> importExplicit m (ValueRef name)) imp' (S.toList $ exportedValues exp)
344− foldM (\m name -> importExplicit m (TypeClassRef name)) imp'' (S.toList $ exportedTypeClasses exp)
344+ imp' <- foldM (\m (name, dctors) -> importExplicit m (TypeRef name (Just dctors))) imp (exportedTypes exp)
345+ imp'' <- foldM (\m name -> importExplicit m (ValueRef name)) imp' (exportedValues exp)
346+ foldM (\m name -> importExplicit m (TypeClassRef name)) imp'' (exportedTypeClasses exp)
345347
346348 -- Import something explicitly
347349 importExplicit :: ImportEnvironment -> DeclarationRef -> Either String ImportEnvironment
@@ -363,10 +365,10 @@ resolveImport currentModule importModule exp imp i = case i of
363365
364366 -- Find all exported data constructors for a given type
365367 allExportedDataConstructors :: ProperName -> [ProperName]
366− allExportedDataConstructors name = fromMaybe [] $ name `lookup` S.toList (exportedTypes exp)
368+ allExportedDataConstructors name = fromMaybe [] $ name `lookup` exportedTypes exp
367369
368370 -- Add something to the ImportEnvironment if it does not already exist there
369− updateImports :: (Ord id, Show id) => M.Map id (Qualified id) -> id -> Either String (M.Map id (Qualified id))
371+ updateImports :: (Ord a, Show a) => M.Map a (Qualified a) -> a -> Either String (M.Map a (Qualified a))
370372 updateImports m name = case M.lookup name m of
371373 Nothing -> return $ M.insert name (Qualified (Just importModule) name) m
372374 Just x@(Qualified (Just mn) _) -> throwError $
@@ -376,18 +378,18 @@ resolveImport currentModule importModule exp imp i = case i of
376378
377379 -- The available values, types, and classes in the module being imported
378380 values = exportedValues exp
379− types = fst `S.map` exportedTypes exp
381+ types = fst `map` exportedTypes exp
380382 classes = exportedTypeClasses exp
381383
382384 -- Ensure that an explicitly imported data constructor exists for the type it is being imported
383385 -- from
384386 checkDctorExists :: [ProperName] -> ProperName -> Either String ProperName
385− checkDctorExists names = checkImportExists "data constructor" (S.fromList names)
387+ checkDctorExists = checkImportExists "data constructor"
386388
387389 -- Check that an explicitly imported item exists in the module it is being imported from
388− checkImportExists :: (Show a, Ord a, Eq a) => String -> S.Set a -> a -> Either String a
390+ checkImportExists :: (Eq a, Show a) => String -> [a] -> a -> Either String a
389391 checkImportExists t exports item =
390− if item `S.member` exports
392+ if item `elem` exports
391393 then return item
392394 else throwError $ "Unable to find " ++ t ++ " '" ++ show (Qualified (Just importModule) item) ++ "'"
393395