diff options
Diffstat (limited to 'compiler/rename/RnNames.lhs')
| -rw-r--r-- | compiler/rename/RnNames.lhs | 129 |
1 files changed, 71 insertions, 58 deletions
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 51c71b083a..c3e8c7033f 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -227,7 +227,7 @@ rnImportDecl this_mod -- True <=> import M () import_all = case imp_details of - Just (is_hiding, ls) -> not is_hiding && null ls + Just (is_hiding, L _ ls) -> not is_hiding && null ls _ -> False -- should the import be safe? @@ -613,18 +613,19 @@ Note that the imp_occ_env will have entries for data constructors too, although we never look up data constructors. \begin{code} -filterImports :: ModIface - -> ImpDeclSpec -- The span for the entire import decl - -> Maybe (Bool, [LIE RdrName]) -- Import spec; True => hiding - -> RnM (Maybe (Bool, [LIE Name]), -- Import spec w/ Names - [GlobalRdrElt]) -- Same again, but in GRE form +filterImports + :: ModIface + -> ImpDeclSpec -- The span for the entire import decl + -> Maybe (Bool, Located [LIE RdrName]) -- Import spec; True => hiding + -> RnM (Maybe (Bool, Located [LIE Name]), -- Import spec w/ Names + [GlobalRdrElt]) -- Same again, but in GRE form filterImports iface decl_spec Nothing = return (Nothing, gresFromAvails prov (mi_exports iface)) where prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }] -filterImports iface decl_spec (Just (want_hiding, import_items)) +filterImports iface decl_spec (Just (want_hiding, L l import_items)) = do -- check for errors, convert RdrNames to Names items1 <- mapM lookup_lie import_items @@ -641,7 +642,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) gres | want_hiding = gresFromAvails hiding_prov pruned_avails | otherwise = concatMap (gresFromIE decl_spec) items2 - return (Just (want_hiding, map fst items2), gres) + return (Just (want_hiding, L l (map fst items2)), gres) where all_avails = mi_exports iface @@ -709,22 +710,23 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) lookup_ie :: IE RdrName -> IELookupM ([(IE Name, AvailInfo)], [IELookupWarning]) lookup_ie ie = handle_bad_import $ do case ie of - IEVar n -> do + IEVar (L l n) -> do (name, avail, _) <- lookup_name n - return ([(IEVar name, trimAvail avail name)], []) + return ([(IEVar (L l name), trimAvail avail name)], []) - IEThingAll tc -> do + IEThingAll (L l tc) -> do (name, avail@(AvailTC name2 subs), mb_parent) <- lookup_name tc let warns | null (drop 1 subs) = [DodgyImport tc] | not (is_qual decl_spec) = [MissingImportList] | otherwise = [] case mb_parent of -- non-associated ty/cls - Nothing -> return ([(IEThingAll name, avail)], warns) + Nothing -> return ([(IEThingAll (L l name), avail)], warns) -- associated ty - Just parent -> return ([(IEThingAll name, + Just parent -> return ([(IEThingAll (L l name), AvailTC name2 (subs \\ [name])), - (IEThingAll name, AvailTC parent [name])], + (IEThingAll (L l name), + AvailTC parent [name])], warns) IEThingAbs tc @@ -741,7 +743,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) -> do nameAvail <- lookup_name tc return ([mkIEThingAbs nameAvail], []) - IEThingWith rdr_tc rdr_ns -> do + IEThingWith (L l rdr_tc) rdr_ns -> do (name, AvailTC _ ns, mb_parent) <- lookup_name rdr_tc -- Look up the children in the sub-names of the parent @@ -758,13 +760,13 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) case mb_parent of -- non-associated ty/cls - Nothing -> return ([(IEThingWith name children, - AvailTC name (name:children))], + Nothing -> return ([(IEThingWith (L l name) children, + AvailTC name (name:map unLoc children))], []) -- associated ty - Just parent -> return ([(IEThingWith name children, - AvailTC name children), - (IEThingWith name children, + Just parent -> return ([(IEThingWith (L l name) children, + AvailTC name (map unLoc children)), + (IEThingWith (L l name) children, AvailTC parent [name])], []) @@ -860,8 +862,8 @@ gresFromIE decl_spec (L loc ie, avail) = gresFromAvail prov_fn avail where is_explicit = case ie of - IEThingAll name -> \n -> n == name - _ -> \_ -> True + IEThingAll (L _ name) -> \n -> n == name + _ -> \_ -> True prov_fn name = Imported [imp_spec] where imp_spec = ImpSpec { is_decl = decl_spec, is_item = item_spec } @@ -876,7 +878,7 @@ mkChildEnv gres = foldr add emptyNameEnv gres findChildren :: NameEnv [Name] -> Name -> [Name] findChildren env n = lookupNameEnv env n `orElse` [] -lookupChildren :: [Name] -> [RdrName] -> [Maybe Name] +lookupChildren :: [Name] -> [Located RdrName] -> [Maybe (Located Name)] -- (lookupChildren all_kids rdr_items) maps each rdr_item to its -- corresponding Name all_kids, if the former exists -- The matching is done by FastString, not OccName, so that @@ -885,8 +887,13 @@ lookupChildren :: [Name] -> [RdrName] -> [Maybe Name] -- the RdrName for AssocTy may have a (bogus) DataName namespace -- (Really the rdr_items should be FastStrings in the first place.) lookupChildren all_kids rdr_items - = map (lookupFsEnv kid_env . occNameFS . rdrNameOcc) rdr_items + -- = map (lookupFsEnv kid_env . occNameFS . rdrNameOcc) rdr_items + = map doOne rdr_items where + doOne (L l r) = case (lookupFsEnv kid_env . occNameFS . rdrNameOcc) r of + Just n -> Just (L l n) + Nothing -> Nothing + kid_env = mkFsEnv [(occNameFS (nameOccName n), n) | n <- all_kids] -- | Combines 'AvailInfo's from the same family @@ -964,7 +971,7 @@ type ExportOccMap = OccEnv (Name, IE RdrName) -- that have the same occurrence name rnExports :: Bool -- False => no 'module M(..) where' header at all - -> Maybe [LIE RdrName] -- Nothing => no explicit export list + -> Maybe (Located [LIE RdrName]) -- Nothing => no explicit export list -> TcGblEnv -> RnM TcGblEnv @@ -991,7 +998,8 @@ rnExports explicit_mod exports ; let real_exports | explicit_mod = exports | ghcLink dflags == LinkInMemory = Nothing - | otherwise = Just [noLoc (IEVar main_RDR_Unqual)] + | otherwise + = Just (noLoc [noLoc (IEVar (noLoc main_RDR_Unqual))]) -- ToDo: the 'noLoc' here is unhelpful if 'main' -- turns out to be out of scope @@ -1007,7 +1015,7 @@ rnExports explicit_mod exports tcg_dus = tcg_dus tcg_env `plusDU` usesOnly (availsToNameSet final_avails) }) } -exports_from_avail :: Maybe [LIE RdrName] +exports_from_avail :: Maybe (Located [LIE RdrName]) -- Nothing => no explicit export list -> GlobalRdrEnv -> ImportAvails @@ -1024,9 +1032,8 @@ exports_from_avail Nothing rdr_env _imports _this_mod in return (Nothing, avails) -exports_from_avail (Just rdr_items) rdr_env imports this_mod +exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod = do (ie_names, _, exports) <- foldlM do_litem emptyExportAccum rdr_items - return (Just ie_names, exports) where do_litem :: ExportAccum -> LIE RdrName -> RnM ExportAccum @@ -1041,8 +1048,9 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum exports_from_item acc@(ie_names, occs, exports) - (L loc (IEModuleContents mod)) - | let earlier_mods = [ mod | (L _ (IEModuleContents mod)) <- ie_names ] + (L loc (IEModuleContents (L lm mod))) + | let earlier_mods = [ mod + | (L _ (IEModuleContents (L _ mod))) <- ie_names ] , mod `elem` earlier_mods -- Duplicate export of M = do { warn_dup_exports <- woptM Opt_WarnDuplicateExports ; warnIf warn_dup_exports (dupModuleExport mod) ; @@ -1067,7 +1075,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod -- The qualified and unqualified version of all of -- these names are, in effect, used by this export - ; occs' <- check_occs (IEModuleContents mod) occs names + ; occs' <- check_occs (IEModuleContents (noLoc mod)) occs names -- This check_occs not only finds conflicts -- between this item and others, but also -- internally within this item. That is, if @@ -1076,7 +1084,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod -- OccName. ; traceRn (vcat [ text "export mod" <+> ppr mod , ppr new_exports ]) - ; return (L loc (IEModuleContents mod) : ie_names, + ; return (L loc (IEModuleContents (L lm mod)) : ie_names, occs', new_exports ++ exports) } exports_from_item acc@(lie_names, occs, exports) (L loc ie) @@ -1096,9 +1104,9 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod ------------- lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo) - lookup_ie (IEVar rdr) + lookup_ie (IEVar (L l rdr)) = do gre <- lookupGreRn rdr - return (IEVar (gre_name gre), greExportAvail gre) + return (IEVar (L l (gre_name gre)), greExportAvail gre) lookup_ie (IEThingAbs rdr) = do gre <- lookupGreRn rdr @@ -1106,7 +1114,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod avail = greExportAvail gre return (IEThingAbs name, avail) - lookup_ie ie@(IEThingAll rdr) + lookup_ie ie@(IEThingAll (L l rdr)) = do name <- lookupGlobalOccRn rdr let kids = findChildren kids_env name addUsedKids rdr kids @@ -1118,20 +1126,21 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod -- only import T abstractly, or T is a synonym. addErr (exportItemErr ie) - return (IEThingAll name, AvailTC name (name:kids)) + return (IEThingAll (L l name), AvailTC name (name:kids)) - lookup_ie ie@(IEThingWith rdr sub_rdrs) + lookup_ie ie@(IEThingWith (L l rdr) sub_rdrs) = do name <- lookupGlobalOccRn rdr if isUnboundName name - then return (IEThingWith name [], AvailTC name [name]) + then return (IEThingWith (L l name) [], AvailTC name [name]) else do let mb_names = lookupChildren (findChildren kids_env name) sub_rdrs if any isNothing mb_names then do addErr (exportItemErr ie) - return (IEThingWith name [], AvailTC name [name]) + return (IEThingWith (L l name) [], AvailTC name [name]) else do let names = catMaybes mb_names - addUsedKids rdr names - return (IEThingWith name names, AvailTC name (name:names)) + addUsedKids rdr (map unLoc names) + return (IEThingWith (L l name) names + , AvailTC name (name:map unLoc names)) lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier @@ -1238,7 +1247,7 @@ dupExport_ok n ie1 ie2 || (explicit_in ie1 && explicit_in ie2) ) where explicit_in (IEModuleContents _) = False -- module M - explicit_in (IEThingAll r) = nameOccName n == rdrNameOcc r -- T(..) + explicit_in (IEThingAll r) = nameOccName n == rdrNameOcc (unLoc r) -- T(..) explicit_in _ = True single (IEVar {}) = True @@ -1254,7 +1263,7 @@ dupExport_ok n ie1 ie2 %********************************************************* \begin{code} -reportUnusedNames :: Maybe [LIE RdrName] -- Export list +reportUnusedNames :: Maybe (Located [LIE RdrName]) -- Export list -> TcGblEnv -> RnM () reportUnusedNames _export_decls gbl_env = do { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env))) @@ -1381,15 +1390,17 @@ findImportUsage imports rdr_env rdrs unused_imps -- Not trivial; see eg Trac #7454 = case imps of - Just (False, imp_ies) -> foldr (add_unused . unLoc) emptyNameSet imp_ies + Just (False, L _ imp_ies) -> + foldr (add_unused . unLoc) emptyNameSet imp_ies _other -> emptyNameSet -- No explicit import list => no unused-name list add_unused :: IE Name -> NameSet -> NameSet - add_unused (IEVar n) acc = add_unused_name n acc - add_unused (IEThingAbs n) acc = add_unused_name n acc - add_unused (IEThingAll n) acc = add_unused_all n acc - add_unused (IEThingWith p ns) acc = add_unused_with p ns acc - add_unused _ acc = acc + add_unused (IEVar (L _ n)) acc = add_unused_name n acc + add_unused (IEThingAbs n) acc = add_unused_name n acc + add_unused (IEThingAll (L _ n)) acc = add_unused_all n acc + add_unused (IEThingWith (L _ p) ns) acc + = add_unused_with p (map unLoc ns) acc + add_unused _ acc = acc add_unused_name n acc | n `elemNameSet` used_names = acc @@ -1447,10 +1458,10 @@ extendImportMap rdr_env rdr imp_map \begin{code} warnUnusedImport :: ImportDeclUsage -> RnM () warnUnusedImport (L loc decl, used, unused) - | Just (False,[]) <- ideclHiding decl + | Just (False,L _ []) <- ideclHiding decl = return () -- Do not warn for 'import M()' - | Just (True, hides) <- ideclHiding decl + | Just (True, L _ hides) <- ideclHiding decl , not (null hides) , pRELUDE_NAME == unLoc (ideclName decl) = return () -- Note [Do not warn about Prelude hiding] @@ -1527,7 +1538,7 @@ printMinimalImports imports_w_usage , ideclPkgQual = mb_pkg } = decl ; iface <- loadSrcInterface doc mod_name is_boot mb_pkg ; let lies = map (L l) (concatMap (to_ie iface) used) - ; return (L l (decl { ideclHiding = Just (False, lies) })) } + ; return (L l (decl { ideclHiding = Just (False, L l lies) })) } where doc = text "Compute minimal imports for" <+> ppr decl @@ -1536,7 +1547,7 @@ printMinimalImports imports_w_usage -- we want to say "T(..)", but if we're importing only a subset we want -- to say "T(A,B,C)". So we have to find out what the module exports. to_ie _ (Avail n) - = [IEVar n] + = [IEVar (noLoc n)] to_ie _ (AvailTC n [m]) | n==m = [IEThingAbs n] to_ie iface (AvailTC n ns) @@ -1544,9 +1555,10 @@ printMinimalImports imports_w_usage , x == n , x `elem` xs -- Note [Partial export] ] of - [xs] | all_used xs -> [IEThingAll n] - | otherwise -> [IEThingWith n (filter (/= n) ns)] - _other -> map IEVar ns + [xs] | all_used xs -> [IEThingAll (noLoc n)] + | otherwise -> [IEThingWith (noLoc n) + (map noLoc (filter (/= n) ns))] + _other -> map (IEVar . noLoc) ns where all_used avail_occs = all (`elem` ns) avail_occs \end{code} @@ -1640,7 +1652,8 @@ dodgyExportWarn item = dodgyMsg (ptext (sLit "export")) item dodgyMsg :: (OutputableBndr n, HasOccName n) => SDoc -> n -> SDoc dodgyMsg kind tc - = sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item") <+> quotes (ppr (IEThingAll tc)) + = sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item") + <+> quotes (ppr (IEThingAll (noLoc tc))) <+> ptext (sLit "suggests that"), quotes (ppr tc) <+> ptext (sLit "has (in-scope) constructors or class methods,"), ptext (sLit "but it has none") ] |