From aa056e7fda12383c88de03c7b2ac611307d8019c Mon Sep 17 00:00:00 2001 From: Lemmih Date: Tue, 14 Mar 2006 16:00:26 +0000 Subject: [PATCH] Bug fixes in my refactored RnNames code. --- ghc/compiler/rename/RnNames.lhs | 44 +++++++++++++++++---------------- ghc/compiler/typecheck/TcRnDriver.lhs | 3 ++- 2 files changed, 25 insertions(+), 22 deletions(-) diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index fc018e7..654c101 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -549,7 +549,7 @@ type ExportAccum -- The type of the accumulating parameter of NameSet) -- The accumulated exported stuff emptyExportAccum = ([], emptyOccEnv, emptyNameSet) -type ExportOccMap = OccEnv (Name, IE Name) +type ExportOccMap = OccEnv (Name, IE RdrName) -- Tracks what a particular exported OccName -- in an export list refers to, and which item -- it came from. It's illegal to export two distinct things @@ -562,9 +562,6 @@ rnExports (Just exports) = do TcGblEnv { tcg_imports = ImportAvails { imp_env = imp_env } } <- getGblEnv let sub_env :: NameEnv [Name] -- Classify each name by its parent sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env) - inLoc fn (L span x) - = do x' <- fn x - return (L span x') rnExport (IEVar rdrName) = do name <- lookupGlobalOccRn rdrName return (IEVar name) @@ -574,21 +571,24 @@ rnExports (Just exports) rnExport (IEThingAll rdrName) = do name <- lookupGlobalOccRn rdrName return (IEThingAll name) - rnExport (IEThingWith rdrName rdrNames) + rnExport ie@(IEThingWith rdrName rdrNames) = do name <- lookupGlobalOccRn rdrName + if isUnboundName name + then return (IEThingWith name []) + else do let env = mkOccEnv [(nameOccName s, s) | s <- subNames sub_env name] mb_names = map (lookupOccEnv env . rdrNameOcc) rdrNames if any isNothing mb_names - then -- The export error will be reporting in 'mkExportNameSet' - return (IEThingWith name []) + then do addErr (exportItemErr ie) + return (IEThingWith name []) else return (IEThingWith name (catMaybes mb_names)) rnExport (IEModuleContents mod) = return (IEModuleContents mod) - rn_exports <- mapM (inLoc rnExport) exports + rn_exports <- mapM (wrapLocM rnExport) exports return (Just rn_exports) mkExportNameSet :: Bool -- False => no 'module M(..) where' header at all - -> Maybe [LIE Name] -- Nothing => no explicit export list + -> Maybe ([LIE Name], [LIE RdrName]) -- Nothing => no explicit export list -> RnM NameSet -- Complains if two distinct exports have same OccName -- Warns about identical exports. @@ -612,7 +612,8 @@ mkExportNameSet explicit_mod exports -> return Nothing | otherwise -> do mainName <- lookupGlobalOccRn main_RDR_Unqual - return (Just [noLoc (IEVar mainName)]) + return (Just ([noLoc (IEVar mainName)] + ,[noLoc (IEVar main_RDR_Unqual)])) -- ToDo: the 'noLoc' here is unhelpful if 'main' turns out to be out of scope exports_from_avail real_exports rdr_env imports @@ -625,18 +626,19 @@ exports_from_avail Nothing rdr_env imports | gre <- globalRdrEnvElts rdr_env, isLocalGRE gre ]) -exports_from_avail (Just items) rdr_env (ImportAvails { imp_env = imp_env }) - = do (_, _, exports) <- foldlM do_litem emptyExportAccum items +exports_from_avail (Just (items,origItems)) rdr_env (ImportAvails { imp_env = imp_env }) + = do (_, _, exports) <- foldlM do_litem emptyExportAccum (zip items origItems) return exports where sub_env :: NameEnv [Name] -- Classify each name by its parent sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env) - do_litem :: ExportAccum -> LIE Name -> RnM ExportAccum - do_litem acc = addLocM (exports_from_item acc) + do_litem :: ExportAccum -> (LIE Name, LIE RdrName) -> RnM ExportAccum + do_litem acc (ieName, ieRdr) + = addLocM (exports_from_item acc (unLoc ieRdr)) ieName - exports_from_item :: ExportAccum -> IE Name -> RnM ExportAccum - exports_from_item acc@(mods, occs, exports) ie@(IEModuleContents mod) + exports_from_item :: ExportAccum -> IE RdrName -> IE Name -> RnM ExportAccum + exports_from_item acc@(mods, occs, exports) ieRdr@(IEModuleContents mod) ie | mod `elem` mods -- Duplicate export of M = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ; warnIf warn_dup_exports (dupModuleExport mod) ; @@ -652,16 +654,16 @@ exports_from_avail (Just items) rdr_env (ImportAvails { imp_env = imp_env }) -- and others, but also internally within this item. That is, -- if 'M.x' is in scope in several ways, we'll have several -- members of mod_avails with the same OccName. - occs' <- check_occs ie occs (nameSetToList new_exports) + occs' <- check_occs ieRdr occs (nameSetToList new_exports) return (mod:mods, occs', exports `unionNameSets` new_exports) - exports_from_item acc@(mods, occs, exports) ie + exports_from_item acc@(mods, occs, exports) ieRdr ie = if isUnboundName (ieName ie) then return acc -- Avoid error cascade else let new_exports = filterAvail ie sub_env in - do checkErr (not (null new_exports)) (exportItemErr ie) + do -- checkErr (not (null (drop 1 new_exports))) (exportItemErr ie) checkForDodgyExport ie new_exports - occs' <- check_occs ie occs new_exports + occs' <- check_occs ieRdr occs new_exports return (mods, occs', addListToNameSet exports new_exports) ------------------------------- @@ -707,7 +709,7 @@ checkForDodgyExport ie@(IEThingAll tc) [n] checkForDodgyExport _ _ = return () ------------------------------- -check_occs :: IE Name -> ExportOccMap -> [Name] -> RnM ExportOccMap +check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap check_occs ie occs names = foldlM check occs names where diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs index a9c8f98..4ca79d9 100644 --- a/ghc/compiler/typecheck/TcRnDriver.lhs +++ b/ghc/compiler/typecheck/TcRnDriver.lhs @@ -230,7 +230,8 @@ tcRnModule hsc_env hsc_src save_rn_syntax -- Process the export list rn_exports <- rnExports export_ies ; - exports <- mkExportNameSet (isJust maybe_mod) rn_exports ; + let { liftM2' fn a b = do a' <- a; b' <- b; return (fn a' b') } ; + exports <- mkExportNameSet (isJust maybe_mod) (liftM2' (,) rn_exports export_ies) ; -- Check whether the entire module is deprecated -- This happens only once per module -- 1.7.10.4