c49a6fb · rowtype-yoga/purescript-native

40-- The exported declarations from a module.

41--

42data Exports = Exports

43− -- |

43+ -- |

44− -- The types exported from each module

44+ -- The types exported from each module

45− --

45+ --

46− { exportedTypes :: [(ProperName, [ProperName])]

46+ { exportedTypes :: [(ProperName, [ProperName])]

47− -- |

47+ -- |

48− -- The classes exported from each module

48+ -- The classes exported from each module

49− --

49+ --

50− , exportedTypeClasses :: [ProperName]

50+ , exportedTypeClasses :: [ProperName]

51− -- |

51+ -- |

52− -- The values exported from each module

52+ -- The values exported from each module

53− , exportedValues :: [Ident]

53+ , exportedValues :: [Ident]

54− --

54+ --

55− } deriving (Show)

55+ } deriving (Show)

56

57-- |

58-- An imported environment for a particular module. This also contains the module's own members.

59--

60data ImportEnvironment = ImportEnvironment

61− -- |

61+ -- |

62− -- Local names for types within a module mapped to to their qualified names

62+ -- Local names for types within a module mapped to to their qualified names

63− --

63+ --

64− { importedTypes :: M.Map ProperName (Qualified ProperName)

64+ { importedTypes :: M.Map ProperName (Qualified ProperName)

65− -- |

65+ -- |

66− -- Local names for data constructors within a module mapped to to their qualified names

66+ -- Local names for data constructors within a module mapped to to their qualified names

67− --

67+ --

68− , importedDataConstructors :: M.Map ProperName (Qualified ProperName)

68+ , importedDataConstructors :: M.Map ProperName (Qualified ProperName)

69− -- |

69+ -- |

70− -- Local names for classes within a module mapped to to their qualified names

70+ -- Local names for classes within a module mapped to to their qualified names

71− --

71+ --

72− , importedTypeClasses :: M.Map ProperName (Qualified ProperName)

72+ , importedTypeClasses :: M.Map ProperName (Qualified ProperName)

73− -- |

73+ -- |

74− -- Local names for values within a module mapped to to their qualified names

74+ -- Local names for values within a module mapped to to their qualified names

75− --

75+ --

76− , importedValues :: M.Map Ident (Qualified Ident)

76+ , importedValues :: M.Map Ident (Qualified Ident)

77− } deriving (Show)

77+ } deriving (Show)

78

79-- |

80-- Updates the exports for a module from the global environment. If the module was not previously

82--

83updateExportedModule :: ExportEnvironment -> ModuleName -> (Exports -> Either String Exports) -> Either String ExportEnvironment

84updateExportedModule env mn update = do

85− let exports = fromMaybe (error "Module was undefined in updateExportedModule") $ mn `M.lookup` env

85+ let exports = fromMaybe (error "Module was undefined in updateExportedModule") $ mn `M.lookup` env

86− exports' <- update exports

86+ exports' <- update exports

87− return $ M.insert mn exports' env

87+ return $ M.insert mn exports' env

88

89-- |

90-- Adds an empty module to an ExportEnvironment.

97--

98addType :: ExportEnvironment -> ModuleName -> ProperName -> [ProperName] -> Either String ExportEnvironment

99addType env mn name dctors = updateExportedModule env mn $ \m -> do

100− types <- addExport (exportedTypes m) (name, dctors)

100+ types <- addExport (exportedTypes m) (name, dctors)

101− return $ m { exportedTypes = types }

101+ return $ m { exportedTypes = types }

102

103-- |

104-- Adds a class to the export environment.

105--

106addTypeClass :: ExportEnvironment -> ModuleName -> ProperName -> Either String ExportEnvironment

107addTypeClass env mn name = updateExportedModule env mn $ \m -> do

108− classes <- addExport (exportedTypeClasses m) name

108+ classes <- addExport (exportedTypeClasses m) name

109− return $ m { exportedTypeClasses = classes }

109+ return $ m { exportedTypeClasses = classes }

110

111-- |

112-- Adds a class to the export environment.

113--

114addValue :: ExportEnvironment -> ModuleName -> Ident -> Either String ExportEnvironment

115addValue env mn name = updateExportedModule env mn $ \m -> do

116− values <- addExport (exportedValues m) name

116+ values <- addExport (exportedValues m) name

117− return $ m { exportedValues = values }

117+ return $ m { exportedValues = values }

118

119-- |

120-- Adds an entry to a list of exports unless it is already present, in which case an error is

122--

123addExport :: (Eq a, Show a) => [a] -> a -> Either String [a]

124addExport exports name =

125− if name `elem` exports

125+ if name `elem` exports

126− then throwError $ "Multiple definitions for '" ++ show name ++ "'"

126+ then throwError $ "Multiple definitions for '" ++ show name ++ "'"

127− else return $ name : exports

127+ else return $ name : exports

128

129-- |

130-- Replaces all local names with qualified names within a set of modules.

131--

132desugarImports :: [Module] -> Either String [Module]

133desugarImports modules = do

134− exports <- findExports modules

134+ exports <- findExports modules

135− mapM (renameInModule' exports) modules

135+ mapM (renameInModule' exports) modules

136− where

136+ where

137− renameInModule' exports m = rethrowForModule m $ do

137+ renameInModule' exports m = rethrowForModule m $ do

138− imports <- resolveImports exports m

138+ imports <- resolveImports exports m

139− renameInModule imports exports m

139+ renameInModule imports exports m

140

141-- |

142-- Rethrow an error with the name of the current module in the case of a failure

150--

151renameInModule :: ImportEnvironment -> ExportEnvironment -> Module -> Either String Module

152renameInModule imports exports (Module mn decls exps) =

153− Module mn <$> (mapM updateDecl decls >>= everywhereM (mkM updateType `extM` updateValue `extM` updateBinder `extM` updateVars)) <*> pure exps

153+ Module mn <$> (mapM updateDecl decls >>= everywhereM (mkM updateType `extM` updateValue `extM` updateBinder `extM` updateVars)) <*> pure exps

154+ where

155+ updateDecl (TypeInstanceDeclaration name cs cn ts ds) =

156+ TypeInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> pure ts <*> pure ds

157+ updateDecl d = return d

158+

159+ updateVars :: Declaration -> Either String Declaration

160+ updateVars (ValueDeclaration name [] Nothing val) =

161+ ValueDeclaration name [] Nothing <$> everywhereWithContextM' [] (mkS bindFunctionArgs `extS` bindBinders) val

154 where

162 where

155− updateDecl (TypeInstanceDeclaration name cs cn ts ds) =

156− TypeInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> pure ts <*> pure ds

157− updateDecl d = return d

158−

159− updateVars :: Declaration -> Either String Declaration

160− updateVars (ValueDeclaration name [] Nothing val) =

161− ValueDeclaration name [] Nothing <$> everywhereWithContextM' [] (mkS bindFunctionArgs `extS` bindBinders) val

162− where

163− bindFunctionArgs bound (Abs (Left arg) val') = return (arg : bound, Abs (Left arg) val')

163+ bindFunctionArgs bound (Abs (Left arg) val') = return (arg : bound, Abs (Left arg) val')

164− bindFunctionArgs bound (Var name'@(Qualified Nothing ident)) | ident `notElem` bound = (,) bound <$> (Var <$> updateValueName name')

164+ bindFunctionArgs bound (Var name'@(Qualified Nothing ident)) | ident `notElem` bound = (,) bound <$> (Var <$> updateValueName name')

165− bindFunctionArgs bound (Var name'@(Qualified (Just _) _)) = (,) bound <$> (Var <$> updateValueName name')

165+ bindFunctionArgs bound (Var name'@(Qualified (Just _) _)) = (,) bound <$> (Var <$> updateValueName name')

166− bindFunctionArgs bound other = return (bound, other)

166+ bindFunctionArgs bound other = return (bound, other)

167− bindBinders :: [Ident] -> CaseAlternative -> Either String ([Ident], CaseAlternative)

167+ bindBinders :: [Ident] -> CaseAlternative -> Either String ([Ident], CaseAlternative)

168− bindBinders bound c@(CaseAlternative bs _ _) = return (binderNames bs ++ bound, c)

168+ bindBinders bound c@(CaseAlternative bs _ _) = return (binderNames bs ++ bound, c)

169− updateVars (ValueDeclaration name _ _ _) = error $ "Binders should have been desugared in " ++ show name

169+ updateVars (ValueDeclaration name _ _ _) = error $ "Binders should have been desugared in " ++ show name

170− updateVars other = return other

170+ updateVars other = return other

171− updateValue (Constructor name) = Constructor <$> updateDataConstructorName name

171+ updateValue (Constructor name) = Constructor <$> updateDataConstructorName name

172− updateValue v = return v

172+ updateValue v = return v

173− updateBinder (ConstructorBinder name b) = ConstructorBinder <$> updateDataConstructorName name <*> pure b

173+ updateBinder (ConstructorBinder name b) = ConstructorBinder <$> updateDataConstructorName name <*> pure b

174− updateBinder v = return v

174+ updateBinder v = return v

175− updateType (TypeConstructor name) = TypeConstructor <$> updateTypeName name

175+ updateType (TypeConstructor name) = TypeConstructor <$> updateTypeName name

176− updateType (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym <$> updateTypeName name <*> mapM updateType tys

176+ updateType (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym <$> updateTypeName name <*> mapM updateType tys

177− updateType (ConstrainedType cs t) = ConstrainedType <$> updateConstraints cs <*> pure t

177+ updateType (ConstrainedType cs t) = ConstrainedType <$> updateConstraints cs <*> pure t

178− updateType t = return t

178+ updateType t = return t

179− updateConstraints = mapM (\(name, ts) -> (,) <$> updateClassName name <*> pure ts)

179+ updateConstraints = mapM (\(name, ts) -> (,) <$> updateClassName name <*> pure ts)

180−

180+

181− updateTypeName (Qualified Nothing name) = update "type" importedTypes name

181+ updateTypeName (Qualified Nothing name) = update "type" importedTypes name

182− updateTypeName (Qualified (Just mn') name) = do

182+ updateTypeName (Qualified (Just mn') name) = do

183− modExports <- getExports mn'

183+ modExports <- getExports mn'

184− case name `lookup` exportedTypes modExports of

184+ case name `lookup` exportedTypes modExports of

185− Nothing -> throwError $ "Unknown type '" ++ show (Qualified (Just mn') name) ++ "'"

185+ Nothing -> throwError $ "Unknown type '" ++ show (Qualified (Just mn') name) ++ "'"

186− _ -> return $ Qualified (Just mn') name

186+ _ -> return $ Qualified (Just mn') name

187−

187+

188− updateDataConstructorName (Qualified Nothing name) = update "data constructor" importedDataConstructors name

188+ updateDataConstructorName (Qualified Nothing name) = update "data constructor" importedDataConstructors name

189− updateDataConstructorName (Qualified (Just mn') name) = do

189+ updateDataConstructorName (Qualified (Just mn') name) = do

190− modExports <- getExports mn'

190+ modExports <- getExports mn'

191− let allDcons = join $ snd `map` exportedTypes modExports

191+ let allDcons = join $ snd `map` exportedTypes modExports

192− if name `elem` allDcons

192+ if name `elem` allDcons

193− then return $ Qualified (Just mn') name

193+ then return $ Qualified (Just mn') name

194− else throwError $ "Unknown data constructor '" ++ show (Qualified (Just mn') name) ++ "'"

194+ else throwError $ "Unknown data constructor '" ++ show (Qualified (Just mn') name) ++ "'"

195−

195+

196− updateClassName (Qualified Nothing name) = update "type class" importedTypeClasses name

196+ updateClassName (Qualified Nothing name) = update "type class" importedTypeClasses name

197− updateClassName (Qualified (Just mn') name) = check "type class" exportedTypeClasses mn' name

197+ updateClassName (Qualified (Just mn') name) = check "type class" exportedTypeClasses mn' name

198−

198+

199− updateValueName (Qualified Nothing name) = update "value" importedValues name

199+ updateValueName (Qualified Nothing name) = update "value" importedValues name

200− updateValueName (Qualified (Just mn') name) = check "value" exportedValues mn' name

200+ updateValueName (Qualified (Just mn') name) = check "value" exportedValues mn' name

201−

201+

202− -- Replace an unqualified name with a qualified

202+ -- Replace an unqualified name with a qualified

203− update :: (Ord a, Show a) => String -> (ImportEnvironment -> M.Map a (Qualified a)) -> a -> Either String (Qualified a)

203+ update :: (Ord a, Show a) => String -> (ImportEnvironment -> M.Map a (Qualified a)) -> a -> Either String (Qualified a)

204− update t get name = maybe (throwError $ "Unknown " ++ t ++ " '" ++ show name ++ "'") return $ M.lookup name (get imports)

204+ update t get name = maybe (throwError $ "Unknown " ++ t ++ " '" ++ show name ++ "'") return $ M.lookup name (get imports)

205−

205+

206− -- Check that a qualified name is valid

206+ -- Check that a qualified name is valid

207− check :: (Show a, Eq a) => String -> (Exports -> [a]) -> ModuleName -> a -> Either String (Qualified a)

207+ check :: (Show a, Eq a) => String -> (Exports -> [a]) -> ModuleName -> a -> Either String (Qualified a)

208− check t get mn' name = do

208+ check t get mn' name = do

209− modExports <- getExports mn'

209+ modExports <- getExports mn'

210− if name `elem` get modExports

210+ if name `elem` get modExports

211− then return $ Qualified (Just mn') name

211+ then return $ Qualified (Just mn') name

212− else throwError $ "Unknown " ++ t ++ " '" ++ show (Qualified (Just mn') name) ++ "'"

212+ else throwError $ "Unknown " ++ t ++ " '" ++ show (Qualified (Just mn') name) ++ "'"

213−

213+

214− -- Gets the exports for a module, or an error message if the module doesn't exist

214+ -- Gets the exports for a module, or an error message if the module doesn't exist

215− getExports :: ModuleName -> Either String Exports

215+ getExports :: ModuleName -> Either String Exports

216− getExports mn' = maybe (throwError $ "Unknown module '" ++ show mn' ++ "'") return $ M.lookup mn' exports

216+ getExports mn' = maybe (throwError $ "Unknown module '" ++ show mn' ++ "'") return $ M.lookup mn' exports

217

218-- |

219-- Finds all exported declarations in a set of modules.

220--

221findExports :: [Module] -> Either String ExportEnvironment

222findExports = foldM addModule $ M.singleton (ModuleName [ProperName "Prim"]) primExports

223− where

223+ where

224

225− -- The exported types from the Prim module

225+ -- The exported types from the Prim module

226− primExports = Exports (mkTypeEntry `map` M.keys primTypes) [] []

226+ primExports = Exports (mkTypeEntry `map` M.keys primTypes) [] []

227− where

227+ where

228− mkTypeEntry (Qualified _ name) = (name, [])

228+ mkTypeEntry (Qualified _ name) = (name, [])

229−

229+

230− -- Add all of the exported declarations from a module to the global export environment

230+ -- Add all of the exported declarations from a module to the global export environment

231− addModule :: ExportEnvironment -> Module -> Either String ExportEnvironment

231+ addModule :: ExportEnvironment -> Module -> Either String ExportEnvironment

232− addModule env m@(Module mn ds Nothing) = rethrowForModule m $ foldM (addDecl mn) (addEmptyModule env mn) ds

232+ addModule env m@(Module mn ds Nothing) = rethrowForModule m $ foldM (addDecl mn) (addEmptyModule env mn) ds

233− addModule env m@(Module mn ds (Just exps)) = rethrowForModule m $ do

233+ addModule env m@(Module mn ds (Just exps)) = rethrowForModule m $ do

234− env' <- foldM (addDecl mn) (addEmptyModule env mn) ds

234+ env' <- foldM (addDecl mn) (addEmptyModule env mn) ds

235− filterExports mn exps env'

235+ filterExports mn exps env'

236−

236+

237− -- Add a declaration from a module to the global export environment

237+ -- Add a declaration from a module to the global export environment

238− addDecl :: ModuleName -> ExportEnvironment -> Declaration -> Either String ExportEnvironment

238+ addDecl :: ModuleName -> ExportEnvironment -> Declaration -> Either String ExportEnvironment

239− addDecl mn env (TypeClassDeclaration tcn _ ds) = do

239+ addDecl mn env (TypeClassDeclaration tcn _ ds) = do

240− env' <- addTypeClass env mn tcn

240+ env' <- addTypeClass env mn tcn

241− foldM (\env'' (TypeDeclaration name _) -> addValue env'' mn name) env' ds

241+ foldM (\env'' (TypeDeclaration name _) -> addValue env'' mn name) env' ds

242− addDecl mn env (DataDeclaration tn _ dcs) = addType env mn tn (map fst dcs)

242+ addDecl mn env (DataDeclaration tn _ dcs) = addType env mn tn (map fst dcs)

243− addDecl mn env (TypeSynonymDeclaration tn _ _) = addType env mn tn []

243+ addDecl mn env (TypeSynonymDeclaration tn _ _) = addType env mn tn []

244− addDecl mn env (ExternDataDeclaration tn _) = addType env mn tn []

244+ addDecl mn env (ExternDataDeclaration tn _) = addType env mn tn []

245− addDecl mn env (ValueDeclaration name _ _ _) = addValue env mn name

245+ addDecl mn env (ValueDeclaration name _ _ _) = addValue env mn name

246− addDecl mn env (ExternDeclaration _ name _ _) = addValue env mn name

246+ addDecl mn env (ExternDeclaration _ name _ _) = addValue env mn name

247− addDecl _ env _ = return env

247+ addDecl _ env _ = return env

248

249-- |

250-- Filters the exports for a module to ensure only explicit exports are kept in the global exports

308--

309findImports :: [Declaration] -> M.Map ModuleName (Maybe ExplicitImports)

310findImports = foldl findImports' M.empty

311− where

311+ where

312− findImports' result (ImportDeclaration mn expl) = M.insert mn expl result

312+ findImports' result (ImportDeclaration mn expl) = M.insert mn expl result

313− findImports' result _ = result

313+ findImports' result _ = result

314

315-- |

316-- Constructs a local environment for a module.

317--

318resolveImports :: ExportEnvironment -> Module -> Either String ImportEnvironment

319resolveImports env (Module currentModule decls _) =

320− foldM resolveImport' (ImportEnvironment M.empty M.empty M.empty M.empty) (M.toList scope)

320+ foldM resolveImport' (ImportEnvironment M.empty M.empty M.empty M.empty) (M.toList scope)

321− where

321+ where

322− -- A Map from module name to imports from that module, where Nothing indicates everything is to be imported

322+ -- A Map from module name to imports from that module, where Nothing indicates everything is to be imported

323− scope :: M.Map ModuleName (Maybe ExplicitImports)

323+ scope :: M.Map ModuleName (Maybe ExplicitImports)

324− scope = M.insert currentModule Nothing (findImports decls)

324+ scope = M.insert currentModule Nothing (findImports decls)

325− resolveImport' imp (mn, i) = do

325+ resolveImport' imp (mn, i) = do

326− m <- maybe (throwError $ "Cannot import unknown module '" ++ show mn ++ "'") return $ mn `M.lookup` env

326+ m <- maybe (throwError $ "Cannot import unknown module '" ++ show mn ++ "'") return $ mn `M.lookup` env

327− resolveImport currentModule mn m imp i

327+ resolveImport currentModule mn m imp i

328

329-- |

330-- Extends the local environment for a module by resolving an import of another module.

331--

332resolveImport :: ModuleName -> ModuleName -> Exports -> ImportEnvironment -> Maybe ExplicitImports -> Either String ImportEnvironment

333resolveImport currentModule importModule exps imps i = case i of

334− Nothing -> importAll

334+ Nothing -> importAll

335− Just expl -> foldM importExplicit imps expl

335+ Just expl -> foldM importExplicit imps expl

336− where

336+ where

337

338− -- Import everything from a module

338+ -- Import everything from a module

339− importAll :: Either String ImportEnvironment

339+ importAll :: Either String ImportEnvironment

340− importAll = do

340+ importAll = do

341− imp' <- foldM (\m (name, dctors) -> importExplicit m (TypeRef name (Just dctors))) imps (exportedTypes exps)

341+ imp' <- foldM (\m (name, dctors) -> importExplicit m (TypeRef name (Just dctors))) imps (exportedTypes exps)

342− imp'' <- foldM (\m name -> importExplicit m (ValueRef name)) imp' (exportedValues exps)

342+ imp'' <- foldM (\m name -> importExplicit m (ValueRef name)) imp' (exportedValues exps)

343− foldM (\m name -> importExplicit m (TypeClassRef name)) imp'' (exportedTypeClasses exps)

343+ foldM (\m name -> importExplicit m (TypeClassRef name)) imp'' (exportedTypeClasses exps)

344−

344+

345− -- Import something explicitly

345+ -- Import something explicitly

346− importExplicit :: ImportEnvironment -> DeclarationRef -> Either String ImportEnvironment

346+ importExplicit :: ImportEnvironment -> DeclarationRef -> Either String ImportEnvironment

347− importExplicit imp (ValueRef name) = do

347+ importExplicit imp (ValueRef name) = do

348− _ <- checkImportExists "value" values name

348+ _ <- checkImportExists "value" values name

349− values' <- updateImports (importedValues imp) name

349+ values' <- updateImports (importedValues imp) name

350− return $ imp { importedValues = values' }

350+ return $ imp { importedValues = values' }

351− importExplicit imp (TypeRef name dctors) = do

351+ importExplicit imp (TypeRef name dctors) = do

352− _ <- checkImportExists "type" types name

352+ _ <- checkImportExists "type" types name

353− types' <- updateImports (importedTypes imp) name

353+ types' <- updateImports (importedTypes imp) name

354− let allDctors = allExportedDataConstructors name

354+ let allDctors = allExportedDataConstructors name

355− dctors' <- maybe (return allDctors) (mapM $ checkDctorExists allDctors) dctors

355+ dctors' <- maybe (return allDctors) (mapM $ checkDctorExists allDctors) dctors

356− dctors'' <- foldM updateImports (importedDataConstructors imp) dctors'

356+ dctors'' <- foldM updateImports (importedDataConstructors imp) dctors'

357− return $ imp { importedTypes = types', importedDataConstructors = dctors'' }

357+ return $ imp { importedTypes = types', importedDataConstructors = dctors'' }

358− importExplicit imp (TypeClassRef name) = do

358+ importExplicit imp (TypeClassRef name) = do

359− _ <- checkImportExists "type class" classes name

359+ _ <- checkImportExists "type class" classes name

360− typeClasses' <- updateImports (importedTypeClasses imp) name

360+ typeClasses' <- updateImports (importedTypeClasses imp) name

361− return $ imp { importedTypeClasses = typeClasses' }

361+ return $ imp { importedTypeClasses = typeClasses' }

362−

362+

363− -- Find all exported data constructors for a given type

363+ -- Find all exported data constructors for a given type

364− allExportedDataConstructors :: ProperName -> [ProperName]

364+ allExportedDataConstructors :: ProperName -> [ProperName]

365− allExportedDataConstructors name = fromMaybe [] $ name `lookup` exportedTypes exps

365+ allExportedDataConstructors name = fromMaybe [] $ name `lookup` exportedTypes exps

366−

366+

367− -- Add something to the ImportEnvironment if it does not already exist there

367+ -- Add something to the ImportEnvironment if it does not already exist there

368− updateImports :: (Ord a, Show a) => M.Map a (Qualified a) -> a -> Either String (M.Map a (Qualified a))

368+ updateImports :: (Ord a, Show a) => M.Map a (Qualified a) -> a -> Either String (M.Map a (Qualified a))

369− updateImports m name = case M.lookup name m of

369+ updateImports m name = case M.lookup name m of

370− Nothing -> return $ M.insert name (Qualified (Just importModule) name) m

370+ Nothing -> return $ M.insert name (Qualified (Just importModule) name) m

371− Just (Qualified Nothing _) -> error "Invalid state in updateImports"

371+ Just (Qualified Nothing _) -> error "Invalid state in updateImports"

372− Just x@(Qualified (Just mn) _) -> throwError $

372+ Just x@(Qualified (Just mn) _) -> throwError $

373− if mn == currentModule || importModule == currentModule

373+ if mn == currentModule || importModule == currentModule

374− then "Definition '" ++ show name ++ "' conflicts with import '" ++ show (Qualified (Just importModule) name) ++ "'"

374+ then "Definition '" ++ show name ++ "' conflicts with import '" ++ show (Qualified (Just importModule) name) ++ "'"

375− else "Conflicting imports for '" ++ show name ++ "': '" ++ show x ++ "', '" ++ show (Qualified (Just importModule) name) ++ "'"

375+ else "Conflicting imports for '" ++ show name ++ "': '" ++ show x ++ "', '" ++ show (Qualified (Just importModule) name) ++ "'"

376−

376+

377− -- The available values, types, and classes in the module being imported

377+ -- The available values, types, and classes in the module being imported

378− values = exportedValues exps

378+ values = exportedValues exps

379− types = fst `map` exportedTypes exps

379+ types = fst `map` exportedTypes exps

380− classes = exportedTypeClasses exps

380+ classes = exportedTypeClasses exps

381−

381+

382− -- Ensure that an explicitly imported data constructor exists for the type it is being imported

382+ -- Ensure that an explicitly imported data constructor exists for the type it is being imported

383− -- from

383+ -- from

384− checkDctorExists :: [ProperName] -> ProperName -> Either String ProperName

384+ checkDctorExists :: [ProperName] -> ProperName -> Either String ProperName

385− checkDctorExists = checkImportExists "data constructor"

385+ checkDctorExists = checkImportExists "data constructor"

386−

386+

387− -- Check that an explicitly imported item exists in the module it is being imported from

387+ -- Check that an explicitly imported item exists in the module it is being imported from

388− checkImportExists :: (Eq a, Show a) => String -> [a] -> a -> Either String a

388+ checkImportExists :: (Eq a, Show a) => String -> [a] -> a -> Either String a

389− checkImportExists t exports item =

389+ checkImportExists t exports item =

390− if item `elem` exports

390+ if item `elem` exports

391− then return item

391+ then return item

392− else throwError $ "Unable to find " ++ t ++ " '" ++ show (Qualified (Just importModule) item) ++ "'"

392+ else throwError $ "Unable to find " ++ t ++ " '" ++ show (Qualified (Just importModule) item) ++ "'"

393