-\begin{code}
-newImportedName :: Bool -- True => tycon or class
- -> SrcLoc
- -> Maybe ExportFlag -- maybe export flag
- -> Maybe ExportFlag -- maybe import flag
- -> RdrName -- orig name
- -> RnM_IInfo s Name
-
-newImportedName tycon_or_class locn maybe_exp maybe_imp rdr
- = getExtraRn `thenRn` \ ((_,b_keys,exp_fn,occ_fn),done_vals,done_tcs,imp_fn) ->
- case if tycon_or_class
- then lookupFM done_tcs (moduleNamePair rdr)
- else lookupFM done_vals (moduleNamePair rdr)
- of
- Just rn -> returnRn (getName rn)
- Nothing ->
- rnGetUnique `thenRn` \ u ->
- let
- uniq = case rdr of
- Qual m n -> u
- Unqual n -> case lookupFM b_keys n of
- Nothing -> u
- Just (key,_) -> key
-
- exp = case maybe_exp of
- Just exp -> exp
- Nothing -> exp_fn n
-
- imp = case maybe_imp of
- Just imp -> imp
- Nothing -> imp_fn n
-
- n = mkImportedName uniq rdr imp locn exp (occ_fn n)
- in
- returnRn n
+ where
+ exports_from_item :: Bool -> ExportAccum -> RdrNameIE -> RnMG ExportAccum
+
+ exports_from_item warn_dups acc@(mods, occs, avails) ie@(IEModuleContents mod)
+ | mod `elem` mods -- Duplicate export of M
+ = warnCheckRn warn_dups (dupModuleExport mod) `thenRn_`
+ returnRn acc
+
+ | otherwise
+ = case lookupFM mod_avail_env mod of
+ Nothing -> failWithRn acc (modExportErr mod)
+ Just mod_avails -> foldlRn (check_occs ie) occs mod_avails
+ `thenRn` \ occs' ->
+ let
+ avails' = foldl addAvail avails mod_avails
+ in
+ returnRn (mod:mods, occs', avails')
+
+ exports_from_item warn_dups acc@(mods, occs, avails) ie
+ | not (maybeToBool maybe_in_scope)
+ = failWithRn acc (unknownNameErr (ieName ie))
+
+ | not (null dup_names)
+ = addNameClashErrRn rdr_name ((name,prov):dup_names) `thenRn_`
+ returnRn acc
+
+#ifdef DEBUG
+ -- I can't see why this should ever happen; if the thing is in scope
+ -- at all it ought to have some availability
+ | not (maybeToBool maybe_avail)
+ = pprTrace "exportsFromAvail: curious Nothing:" (ppr name)
+ returnRn acc
+#endif
+
+ | not enough_avail
+ = failWithRn acc (exportItemErr ie)
+
+ | otherwise -- Phew! It's OK! Now to check the occurrence stuff!
+
+
+ = warnCheckRn (ok_item ie avail) (dodgyExportWarn ie) `thenRn_`
+ check_occs ie occs export_avail `thenRn` \ occs' ->
+ returnRn (mods, occs', addAvail avails export_avail)
+
+ where
+ rdr_name = ieName ie
+ maybe_in_scope = lookupFM global_name_env rdr_name
+ Just ((name,prov):dup_names) = maybe_in_scope
+ maybe_avail = lookupUFM entity_avail_env name
+ Just avail = maybe_avail
+ maybe_export_avail = filterAvail ie avail
+ enough_avail = maybeToBool maybe_export_avail
+ Just export_avail = maybe_export_avail
+
+ ok_item (IEThingAll _) (AvailTC _ [n]) = False
+ -- This occurs when you import T(..), but
+ -- only export T abstractly. The single [n]
+ -- in the AvailTC is the type or class itself
+ ok_item _ _ = True
+
+check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap
+check_occs ie occs avail
+ = doptRn Opt_WarnDuplicateExports `thenRn` \ warn_dup_exports ->
+ foldlRn (check warn_dup_exports) occs (availNames avail)
+ where
+ check warn_dup occs name
+ = case lookupFM occs name_occ of
+ Nothing -> returnRn (addToFM occs name_occ (name, ie))
+ Just (name', ie')
+ | name == name' -> -- Duplicate export
+ warnCheckRn warn_dup
+ (dupExportWarn name_occ ie ie')
+ `thenRn_` returnRn occs
+
+ | otherwise -> -- Same occ name but different names: an error
+ failWithRn occs (exportClashErr name_occ ie ie')
+ where
+ name_occ = nameOccName name
+
+mk_export_fn :: NameSet -> (Name -> Bool) -- True => exported
+mk_export_fn exported_names = \name -> name `elemNameSet` exported_names