+ trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
+ trashed_imports = {-trace "rnSource:trashed_imports"-} []
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Export list}
+%* *
+%*********************************************************
+
+\begin{code}
+rnExports :: [Module]
+ -> Bag (Module,RnName)
+ -> Maybe [RdrNameIE]
+ -> RnM s (Name -> ExportFlag)
+
+rnExports mods unqual_imps Nothing
+ = returnRn (\n -> if isLocallyDefined n then ExportAll else NotExported)
+
+rnExports mods unqual_imps (Just exps)
+ = mapAndUnzipRn (rnIE mods) exps `thenRn` \ (mod_maybes, exp_bags) ->
+ let
+ exp_names = bagToList (unionManyBags exp_bags)
+ exp_mods = catMaybes mod_maybes
+
+ -- Warn for duplicate names and modules
+ (uniq_exp_names, dup_names) = removeDups cmp_fst exp_names
+ (uniq_exp_mods, dup_mods) = removeDups cmpPString exp_mods
+ cmp_fst (x,_) (y,_) = x `cmp` y
+
+ -- Build finite map of exported names to export flag
+ exp_map0 = addListToUFM_C lub_expflag emptyUFM (map pair_fst uniq_exp_names)
+ (exp_map1, empty_mods) = foldl add_mod_names (exp_map0, []) uniq_exp_mods
+
+ mod_fm = addListToFM_C unionBags emptyFM
+ [(mod, unitBag (getName rn, nameImportFlag (getName rn)))
+ | (mod,rn) <- bagToList unqual_imps, isRnDecl rn]
+
+ add_mod_names (exp_map, empty) mod
+ = case lookupFM mod_fm mod of
+ Nothing -> (exp_map, mod:empty)
+ Just mod_names -> (addListToUFM_C lub_expflag exp_map (map pair_fst (bagToList mod_names)), empty)
+
+ pair_fst p@(f,_) = (f,p)
+ lub_expflag (n, flag1) (_, flag2) = (n, lubExportFlag flag1 flag2)
+
+ -- Check for exporting of duplicate local names
+ exp_locals = [(getLocalName n, n) | (n,_) <- eltsUFM exp_map1]
+ (_, dup_locals) = removeDups cmp_local exp_locals
+ cmp_local (x,_) (y,_) = x `cmpPString` y
+
+ -- Build export flag function
+ exp_fn n = case lookupUFM exp_map1 n of
+ Nothing -> NotExported
+ Just (_,flag) -> flag
+ in
+ getSrcLocRn `thenRn` \ src_loc ->
+ mapRn (addWarnRn . dupNameExportWarn src_loc) dup_names `thenRn_`
+ mapRn (addWarnRn . dupModExportWarn src_loc) dup_mods `thenRn_`
+ mapRn (addWarnRn . emptyModExportWarn src_loc) empty_mods `thenRn_`
+ mapRn (addErrRn . dupLocalsExportErr src_loc) dup_locals `thenRn_`
+ returnRn exp_fn
+
+
+rnIE mods (IEVar name)
+ = lookupValue name `thenRn` \ rn ->
+ checkIEVar rn `thenRn` \ exps ->
+ returnRn (Nothing, exps)
+ where
+ checkIEVar (RnName n) = returnRn (unitBag (n,ExportAll))
+ checkIEVar rn@(RnClassOp _ _) = getSrcLocRn `thenRn` \ src_loc ->
+ failButContinueRn emptyBag (classOpExportErr rn src_loc)
+ checkIEVar rn = returnRn emptyBag
+
+rnIE mods (IEThingAbs name)
+ = lookupTyConOrClass name `thenRn` \ rn ->
+ checkIEAbs rn `thenRn` \ exps ->
+ returnRn (Nothing, exps)
+ where
+ checkIEAbs (RnSyn n) = returnRn (unitBag (n,ExportAbs))
+ checkIEAbs (RnData n _ _) = returnRn (unitBag (n,ExportAbs))
+ checkIEAbs (RnClass n _) = returnRn (unitBag (n,ExportAbs))
+ checkIEAbs rn = returnRn emptyBag
+
+rnIE mods (IEThingAll name)
+ = lookupTyConOrClass name `thenRn` \ rn ->
+ checkIEAll rn `thenRn` \ exps ->
+ checkImportAll rn `thenRn_`
+ returnRn (Nothing, exps)
+ where
+ checkIEAll (RnData n cons fields) = returnRn (exp_all n `consBag` listToBag (map exp_all cons)
+ `unionBags` listToBag (map exp_all fields))
+ checkIEAll (RnClass n ops) = returnRn (exp_all n `consBag` listToBag (map exp_all ops))
+ checkIEAll rn@(RnSyn n) = getSrcLocRn `thenRn` \ src_loc ->
+ warnAndContinueRn (unitBag (n, ExportAbs))
+ (synAllExportErr False{-warning-} rn src_loc)
+ checkIEAll rn = returnRn emptyBag
+
+ exp_all n = (n, ExportAll)
+
+rnIE mods (IEThingWith name names)
+ = lookupTyConOrClass name `thenRn` \ rn ->
+ mapRn lookupValue names `thenRn` \ rns ->
+ checkIEWith rn rns `thenRn` \ exps ->
+ checkImportAll rn `thenRn_`
+ returnRn (Nothing, exps)
+ where
+ checkIEWith rn@(RnData n cons fields) rns
+ | same_names (cons++fields) rns
+ = returnRn (consBag (exp_all n) (listToBag (map exp_all cons)))
+ | otherwise
+ = rnWithErr "constructrs (and fields)" rn (cons++fields) rns
+ checkIEWith rn@(RnClass n ops) rns
+ | same_names ops rns
+ = returnRn (consBag (exp_all n) (listToBag (map exp_all ops)))
+ | otherwise
+ = rnWithErr "class ops" rn ops rns
+ checkIEWith rn@(RnSyn _) rns
+ = getSrcLocRn `thenRn` \ src_loc ->
+ failButContinueRn emptyBag (synAllExportErr True{-error-} rn src_loc)
+ checkIEWith rn rns
+ = returnRn emptyBag
+
+ exp_all n = (n, ExportAll)
+
+ same_names has rns
+ = all (not.isRnUnbound) rns &&
+ sortLt (<) (map uniqueOf has) == sortLt (<) (map uniqueOf rns)
+
+ rnWithErr str rn has rns
+ = getSrcLocRn `thenRn` \ src_loc ->
+ failButContinueRn emptyBag (withExportErr str rn has rns src_loc)
+
+rnIE mods (IEModuleContents mod)
+ | isIn "rnIE:IEModule" mod mods
+ = returnRn (Just mod, emptyBag)
+ | otherwise
+ = getSrcLocRn `thenRn` \ src_loc ->
+ failButContinueRn (Nothing,emptyBag) (badModExportErr mod src_loc)
+
+
+checkImportAll rn
+ = case nameImportFlag (getName rn) of
+ ExportAll -> returnRn ()
+ exp -> getSrcLocRn `thenRn` \ src_loc ->
+ addErrRn (importAllErr rn src_loc)