RnEnv(..), QualNames(..),
UnqualNames(..), ScopeStack(..),
emptyRnEnv, extendGlobalRnEnv, extendLocalRnEnv,
- lookupRnEnv, lookupTcRnEnv,
+ lookupRnEnv, lookupGlobalRnEnv, lookupTcRnEnv,
- unknownNameErr,
- badClassOpErr,
- qualNameErr,
- dupNamesErr,
- shadowedNameWarn,
- multipleOccWarn,
+ lubExportFlag,
- -- ToDo: nuke/move? WDP 96/04/05
- GlobalNameMapper(..), GlobalNameMappers(..)
+ qualNameErr,
+ dupNamesErr
) where
-import Ubiq
+IMP_Ubiq(){-uitous-}
import Bag ( Bag, emptyBag, snocBag, unionBags )
-import ErrUtils ( addShortErrLocLine, addErrLoc )
+import CmdLineOpts ( opt_CompilingPrelude )
+import ErrUtils ( addShortErrLocLine )
import FiniteMap ( FiniteMap, emptyFM, isEmptyFM,
lookupFM, addListToFM, addToFM )
import Maybes ( maybeToBool )
-import Name ( RdrName(..), isQual )
-import Outputable ( pprNonOp, getLocalName )
+import Name ( RdrName(..), isQual, pprNonSym, getLocalName, ExportFlag(..) )
import PprStyle ( PprStyle(..) )
import Pretty
import RnHsSyn ( RnName )
import Util ( assertPanic )
-
-type GlobalNameMapper = RnName -> Maybe Name
-type GlobalNameMappers = (GlobalNameMapper, GlobalNameMapper)
\end{code}
*********************************************************
* *
*********************************************************
-Seperate FiniteMaps are kept for lookup up Qual names,
+Separate FiniteMaps are kept for lookup up Qual names,
Unqual names and Local names.
\begin{code}
-> (RnEnv, Bag (RdrName, RnName, RnName))
extendLocalRnEnv :: Bool -> RnEnv -> [RnName] -> (RnEnv, [RnName])
lookupRnEnv :: RnEnv -> RdrName -> Maybe RnName
+lookupGlobalRnEnv :: RnEnv -> RdrName -> Maybe RnName
lookupTcRnEnv :: RnEnv -> RdrName -> Maybe RnName
\end{code}
@lookupTcRnEnv@ looks up tycons/classes in the alternative global
name space.
-@extendGlobalRnEnv@ adds global names to the RnEnv. It takes seperate
+@extendGlobalRnEnv@ adds global names to the RnEnv. It takes separate
value and tycon/class name lists. It returns any duplicate names
-seperatle.
+seperately.
@extendRnEnv@ adds new local names to the ScopeStack in an RnEnv.
It optionally reports any shadowed names.
emptyRnEnv
= ((emptyFM, emptyFM, emptyFM, emptyFM), emptyFM)
-
extendGlobalRnEnv ((qual, unqual, tc_qual, tc_unqual), stack) val_list tc_list
= ASSERT(isEmptyFM stack)
- (((qual', unqual', tc_qual, tc_unqual), stack), tc_dups `unionBags` dups)
+ (((qual', unqual', tc_qual', tc_unqual'), stack), tc_dups `unionBags` dups)
where
(qual', unqual', dups) = extend_global qual unqual val_list
(tc_qual', tc_unqual', tc_dups) = extend_global tc_qual tc_unqual tc_list
lookupRnEnv ((qual, unqual, _, _), stack) rdr
= case rdr of
Unqual str -> lookup stack str (lookup unqual str Nothing)
- Qual mod str -> lookup qual (str,mod) Nothing
+ Qual mod str -> lookup qual (str,mod)
+ (if not opt_CompilingPrelude -- see below
+ then Nothing
+ else lookup unqual str Nothing)
where
lookup fm thing do_on_fail
= case lookupFM fm thing of
found@(Just name) -> found
Nothing -> do_on_fail
+lookupGlobalRnEnv ((qual, unqual, _, _), _) rdr
+ = case rdr of
+ Unqual str -> lookupFM unqual str
+ Qual mod str -> case (lookupFM qual (str,mod)) of
+ Just xx -> Just xx
+ Nothing -> if not opt_CompilingPrelude then
+ Nothing
+ else -- "[]" may have turned into "Prelude.[]" and
+ -- we are actually compiling "data [] a = ...";
+ -- maybe the right thing is to get "Prelude.[]"
+ -- into the "qual" table...
+ lookupFM unqual str
+
lookupTcRnEnv ((_, _, tc_qual, tc_unqual), _) rdr
= case rdr of
Unqual str -> lookupFM tc_unqual str
- Qual mod str -> lookupFM tc_qual (str,mod)
+ Qual mod str -> case (lookupFM tc_qual (str,mod)) of -- as above
+ Just xx -> Just xx
+ Nothing -> if not opt_CompilingPrelude then
+ Nothing
+ else
+ lookupFM tc_unqual str
\end{code}
*********************************************************
* *
-\subsection{Errors used in RnMonad}
+\subsection{Export Flag Functions}
* *
*********************************************************
\begin{code}
-unknownNameErr descriptor name locn
- = addShortErrLocLine locn ( \ sty ->
- ppBesides [ppStr "undefined ", ppStr descriptor, ppStr ": ", pprNonOp sty name] )
+lubExportFlag ExportAll ExportAll = ExportAll
+lubExportFlag ExportAll ExportAbs = ExportAll
+lubExportFlag ExportAbs ExportAll = ExportAll
+lubExportFlag ExportAbs ExportAbs = ExportAbs
+\end{code}
-badClassOpErr clas op locn
- = addErrLoc locn "" ( \ sty ->
- ppBesides [ppChar '`', pprNonOp sty op, ppStr "' is not an operation of class `",
- ppr sty clas, ppStr "'"] )
+*********************************************************
+* *
+\subsection{Errors used *more than once* in the renamer}
+* *
+*********************************************************
+\begin{code}
qualNameErr descriptor (name,locn)
= addShortErrLocLine locn ( \ sty ->
- ppBesides [ppStr "invalid use of qualified ", ppStr descriptor, ppStr ": ", pprNonOp sty name ] )
+ ppBesides [ppStr "invalid use of qualified ", ppStr descriptor, ppStr ": ", pprNonSym sty name ] )
dupNamesErr descriptor ((name1,locn1) : dup_things) sty
= ppAboves (item1 : map dup_item dup_things)
where
item1
- = ppBesides [ ppr PprForUser locn1,
- ppStr ": multiple declarations of a ", ppStr descriptor, ppStr ": ",
- pprNonOp sty name1 ]
+ = addShortErrLocLine locn1 (\ sty ->
+ ppBesides [ppStr "multiple declarations of a ", ppStr descriptor, ppStr " `",
+ pprNonSym sty name1, ppStr "'" ]) sty
dup_item (name, locn)
- = ppBesides [ ppr PprForUser locn,
- ppStr ": here was another declaration of `", pprNonOp sty name, ppStr "'" ]
-
-shadowedNameWarn locn shadow
- = addShortErrLocLine locn ( \ sty ->
- ppBesides [ppStr "more than one value with the same name (shadowing): ", ppr sty shadow] )
-
-multipleOccWarn (name, occs) sty
- = ppBesides [ppStr "multiple names used to refer to `", ppr sty name, ppStr "': ",
- ppInterleave ppComma (map (ppr sty) occs)]
+ = addShortErrLocLine locn (\ sty ->
+ ppBesides [ppStr "here was another declaration of `",
+ pprNonSym sty name, ppStr "'" ]) sty
\end{code}
projects / ghc-hetmet.git / blobdiff