import Bag ( emptyBag, unitBag, consBag, unionManyBags, unionBags, listToBag, bagToList )
import Class ( derivableClassKeys )
-import ErrUtils ( addErrLoc, addShortErrLocLine )
+import ErrUtils ( addErrLoc, addShortErrLocLine, addShortWarnLocLine )
import FiniteMap ( emptyFM, lookupFM, addListToFM_C )
import ListSetOps ( unionLists, minusList )
import Maybes ( maybeToBool, catMaybes )
import Name ( Name, isLocallyDefined, isLexVarId, getLocalName, ExportFlag(..),
nameImportFlag, RdrName, pprNonSym )
-import Outputable -- ToDo:rm
-import PprStyle -- ToDo:rm
+import Outputable -- ToDo:rm
+import PprStyle -- ToDo:rm
import PrelInfo ( consDataCon )
import Pretty
import SrcLoc ( SrcLoc )
\begin{code}
-rnSource :: [Module]
+rnSource :: [Module] -- imported modules
-> Bag (Module,RnName) -- unqualified imports from module
-> Bag RenamedFixityDecl -- fixity info for imported names
-> RdrNameHsModule
all_fixes = src_fixes ++ bagToList imp_fixes
all_fixes_fm = listToUFM (map pair_name all_fixes)
- pair_name inf = (nameFixDecl inf, inf)
+ pair_name inf = (fixDeclName inf, inf)
in
setExtraRn all_fixes_fm $
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 _) = getSrcLocRn `thenRn` \ src_loc ->
- warnAndContinueRn emptyBag (synAllExportErr rn src_loc)
+ 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)
= rnWithErr "class ops" rn ops rns
checkIEWith rn@(RnSyn _) rns
= getSrcLocRn `thenRn` \ src_loc ->
- failButContinueRn emptyBag (synAllExportErr rn src_loc)
+ failButContinueRn emptyBag (synAllExportErr True{-error-} rn src_loc)
checkIEWith rn rns
= returnRn emptyBag
= getSrcLocRn `thenRn` \ src_loc ->
let
(_, dup_fixes) = removeDups cmp_fix fixities
- cmp_fix fix1 fix2 = nameFixDecl fix1 `cmp` nameFixDecl fix2
+ cmp_fix fix1 fix2 = fixDeclName fix1 `cmp` fixDeclName fix2
rn_fixity fix@(InfixL name i)
= rn_fixity_pieces InfixL name i fix
mapRn (addErrRn . dupFixityDeclErr src_loc) dup_fixes `thenRn_`
mapRn rn_fixity fixities `thenRn` \ fixes_maybe ->
returnRn (catMaybes fixes_maybe)
-
-nameFixDecl (InfixL name i) = name
-nameFixDecl (InfixR name i) = name
-nameFixDecl (InfixN name i) = name
\end{code}
%*********************************************************
\begin{code}
dupNameExportWarn locn names@((n,_):_)
- = addShortErrLocLine locn (\ sty ->
+ = addShortWarnLocLine locn (\ sty ->
ppCat [pprNonSym sty n, ppStr "exported", ppInt (length names), ppStr "times"])
dupLocalsExportErr locn locals@((str,_):_)
= addShortErrLocLine locn (\ sty ->
ppBesides [ppStr "class operation `", ppr sty op, ppStr "' can only be exported with class"])
-synAllExportErr syn locn
- = addShortErrLocLine locn (\ sty ->
+synAllExportErr is_error syn locn
+ = (if is_error then addShortErrLocLine else addShortWarnLocLine) locn (\ sty ->
ppBesides [ppStr "type synonym `", ppr sty syn, ppStr "' should be exported abstractly"])
withExportErr str rn has rns locn
= addErrLoc locn "" (\ sty ->
- ppAboves [ ppBesides [ppStr "inconsistent list of", ppStr str, ppStr "in export list for `", ppr sty rn, ppStr "'"],
+ ppAboves [ ppBesides [ppStr "inconsistent list of ", ppStr str, ppStr " in export list for `", ppr sty rn, ppStr "'"],
ppCat [ppStr " expected:", ppInterleave ppComma (map (ppr sty) has)],
ppCat [ppStr " found: ", ppInterleave ppComma (map (ppr sty) rns)] ])
badModExportErr mod locn
= addShortErrLocLine locn (\ sty ->
- ppCat [ ppStr "unknown module in export list:", ppPStr mod])
-
-dupModExportWarn locn mods@(mod:_)
- = addShortErrLocLine locn (\ sty ->
- ppCat [ppStr "module", ppPStr mod, ppStr "appears", ppInt (length mods), ppStr "times in export list"])
+ ppCat [ ppStr "unknown module in export list: module", ppPStr mod])
emptyModExportWarn locn mod
- = addShortErrLocLine locn (\ sty ->
+ = addShortWarnLocLine locn (\ sty ->
ppCat [ppStr "module", ppPStr mod, ppStr "has no unqualified imports to export"])
+dupModExportWarn locn mods@(mod:_)
+ = addShortWarnLocLine locn (\ sty ->
+ ppCat [ppStr "module", ppPStr mod, ppStr "appears", ppInt (length mods), ppStr "times in export list"])
+
derivingNonStdClassErr clas locn
= addShortErrLocLine locn (\ sty ->
ppCat [ppStr "non-standard class in deriving:", ppr sty clas])