[project @ 2000-10-12 11:47:25 by sewardj]

[ghc-hetmet.git] / ghc / compiler / basicTypes / RdrName.lhs

diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs
index 3e5f52e..a438c65 100644 (file)
--- a/ghc/compiler/basicTypes/RdrName.lhs
+++ b/ghc/compiler/basicTypes/RdrName.lhs
@@ -1,4 +1,4 @@
-
+%
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 
@@ -10,27 +10,36 @@ module RdrName (
 
        -- Construction
        mkRdrUnqual, mkRdrQual,
-       mkSrcUnqual, mkSrcQual, 
+       mkUnqual, mkQual, 
        mkSysUnqual, mkSysQual,
-       mkPreludeQual, qualifyRdrName,
+       mkPreludeQual, qualifyRdrName, mkRdrNameWkr,
        dummyRdrVarName, dummyRdrTcName,
 
        -- Destruction
-       rdrNameModule, rdrNameOcc, 
-       isRdrDataCon, isRdrTyVar, isQual, isUnqual
+       rdrNameModule, rdrNameOcc, setRdrNameOcc,
+       isRdrDataCon, isRdrTyVar, isQual, isUnqual,
+
+       -- Environment
+       RdrNameEnv, 
+       emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts, 
+       extendRdrEnv, rdrEnvToList,
+
+       -- Printing;    instance Outputable RdrName
+       pprUnqualRdrName 
   ) where 
 
 #include "HsVersions.h"
 
 import OccName ( NameSpace, tcName,
-                 OccName,
+                 OccName, UserFS,
                  mkSysOccFS,
-                 mkSrcOccFS, mkSrcVarOcc,
-                 isDataOcc, isTvOcc
+                 mkOccFS, mkVarOcc,
+                 isDataOcc, isTvOcc, mkWorkerOcc
                )
 import Module   ( ModuleName,
-                 mkSysModuleFS, mkSrcModuleFS
+                 mkSysModuleNameFS, mkModuleNameFS
                )
+import FiniteMap
 import Outputable
 import Util    ( thenCmp )
 \end{code}
@@ -62,6 +71,9 @@ rdrNameModule (RdrName (Qual m) _) = m
 
 rdrNameOcc :: RdrName -> OccName
 rdrNameOcc (RdrName _ occ) = occ
+
+setRdrNameOcc :: RdrName -> OccName -> RdrName
+setRdrNameOcc (RdrName q _) occ = RdrName q occ
 \end{code}
 
 \begin{code}
@@ -74,11 +86,11 @@ mkRdrQual mod occ = RdrName (Qual mod) occ
 
        -- These two are used when parsing source files
        -- They do encode the module and occurrence names
-mkSrcUnqual :: NameSpace -> FAST_STRING -> RdrName
-mkSrcUnqual sp n = RdrName Unqual (mkSrcOccFS sp n)
+mkUnqual :: NameSpace -> FAST_STRING -> RdrName
+mkUnqual sp n = RdrName Unqual (mkOccFS sp n)
 
-mkSrcQual :: NameSpace -> FAST_STRING -> FAST_STRING -> RdrName
-mkSrcQual sp m n = RdrName (Qual (mkSrcModuleFS m)) (mkSrcOccFS sp n)
+mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
+mkQual sp (m, n) = RdrName (Qual (mkModuleNameFS m)) (mkOccFS sp n)
 
        -- These two are used when parsing interface files
        -- They do not encode the module and occurrence name
@@ -86,14 +98,17 @@ mkSysUnqual :: NameSpace -> FAST_STRING -> RdrName
 mkSysUnqual sp n = RdrName Unqual (mkSysOccFS sp n)
 
 mkSysQual :: NameSpace -> (FAST_STRING, FAST_STRING) -> RdrName
-mkSysQual sp (m,n) = RdrName (Qual (mkSysModuleFS m)) (mkSysOccFS sp n)
+mkSysQual sp (m,n) = RdrName (Qual (mkSysModuleNameFS m)) (mkSysOccFS sp n)
 
 mkPreludeQual :: NameSpace -> ModuleName -> FAST_STRING -> RdrName
-mkPreludeQual sp mod n = RdrName (Qual mod) (mkSrcOccFS sp n)
+mkPreludeQual sp mod n = RdrName (Qual mod) (mkOccFS sp n)
 
 qualifyRdrName :: ModuleName -> RdrName -> RdrName
-qualifyRdrName mod (RdrName Unqual occ) = RdrName (Qual mod) occ
-qualifyRdrName mod rdr_name            = rdr_name 
+       -- Sets the module name of a RdrName, even if it has one already
+qualifyRdrName mod (RdrName _ occ) = RdrName (Qual mod) occ
+
+mkRdrNameWkr :: RdrName -> RdrName     -- Worker-ify it
+mkRdrNameWkr (RdrName qual occ) = RdrName qual (mkWorkerOcc occ)
 \end{code}
 
 \begin{code}
@@ -102,8 +117,8 @@ qualifyRdrName mod rdr_name         = rdr_name
        -- the renamer.  We can't just put "error..." because
        -- we sometimes want to print out stuff after reading but
        -- before renaming
-dummyRdrVarName = RdrName Unqual (mkSrcVarOcc SLIT("V-DUMMY"))
-dummyRdrTcName  = RdrName Unqual (mkSrcOccFS tcName SLIT("TC-DUMMY"))
+dummyRdrVarName = RdrName Unqual (mkVarOcc SLIT("V-DUMMY"))
+dummyRdrTcName  = RdrName Unqual (mkOccFS tcName SLIT("TC-DUMMY"))
 \end{code}
 
 
@@ -128,8 +143,10 @@ isQual rdr_name = not (isUnqual rdr_name)
 instance Outputable RdrName where
     ppr (RdrName qual occ) = pp_qual qual <> ppr occ
                           where
-                               pp_qual Unqual = empty
-                               pp_qual (Qual mod) = ppr mod <> dot
+                            pp_qual Unqual     = empty
+                            pp_qual (Qual mod) = ppr mod <> dot
+
+pprUnqualRdrName (RdrName qual occ) = ppr occ
 
 instance Eq RdrName where
     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
@@ -153,3 +170,26 @@ cmpQual (Qual m1) (Qual m2) = m1 `compare` m2
 
 
 
+%************************************************************************
+%*                                                                     *
+\subsection{Environment}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+type RdrNameEnv a = FiniteMap RdrName a
+
+emptyRdrEnv    :: RdrNameEnv a
+lookupRdrEnv   :: RdrNameEnv a -> RdrName -> Maybe a
+addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
+extendRdrEnv   :: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
+rdrEnvToList    :: RdrNameEnv a -> [(RdrName, a)]
+rdrEnvElts     :: RdrNameEnv a -> [a]
+
+emptyRdrEnv  = emptyFM
+lookupRdrEnv = lookupFM
+addListToRdrEnv = addListToFM
+rdrEnvElts     = eltsFM
+extendRdrEnv    = addToFM
+rdrEnvToList    = fmToList
+\end{code}