projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2000-11-13 12:43:20 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
4644c79
..
dab3594
100644
(file)
--- a/
ghc/compiler/basicTypes/RdrName.lhs
+++ b/
ghc/compiler/basicTypes/RdrName.lhs
@@
-9,20
+9,19
@@
module RdrName (
RdrName,
-- Construction
RdrName,
-- Construction
- mkRdrUnqual, mkRdrQual,
- mkSrcUnqual, mkSrcQual,
- mkSysUnqual, mkSysQual,
- mkPreludeQual, qualifyRdrName, mkRdrNameWkr,
+ mkRdrUnqual, mkRdrQual, mkRdrOrig, mkRdrUnqual,
+ mkUnqual, mkQual, mkIfaceOrig, mkOrig,
+ qualifyRdrName, mkRdrNameWkr,
dummyRdrVarName, dummyRdrTcName,
-- Destruction
rdrNameModule, rdrNameOcc, setRdrNameOcc,
dummyRdrVarName, dummyRdrTcName,
-- Destruction
rdrNameModule, rdrNameOcc, setRdrNameOcc,
- isRdrDataCon, isRdrTyVar, isQual, isUnqual,
+ isRdrDataCon, isRdrTyVar, isQual, isUnqual, isOrig,
-- Environment
RdrNameEnv,
emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts,
-- Environment
RdrNameEnv,
emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts,
- extendRdrEnv, rdrEnvToList,
+ extendRdrEnv, rdrEnvToList, elemRdrEnv, foldRdrEnv,
-- Printing; instance Outputable RdrName
pprUnqualRdrName
-- Printing; instance Outputable RdrName
pprUnqualRdrName
@@
-31,9
+30,9
@@
module RdrName (
#include "HsVersions.h"
import OccName ( NameSpace, tcName,
#include "HsVersions.h"
import OccName ( NameSpace, tcName,
- OccName, UserFS,
+ OccName, UserFS, EncodedFS,
mkSysOccFS,
mkSysOccFS,
- mkSrcOccFS, mkSrcVarOcc,
+ mkOccFS, mkVarOcc,
isDataOcc, isTvOcc, mkWorkerOcc
)
import Module ( ModuleName,
isDataOcc, isTvOcc, mkWorkerOcc
)
import Module ( ModuleName,
@@
-55,7
+54,14
@@
import Util ( thenCmp )
data RdrName = RdrName Qual OccName
data Qual = Unqual
data RdrName = RdrName Qual OccName
data Qual = Unqual
- | Qual ModuleName -- The (encoded) module name
+
+ | Qual ModuleName -- A qualified name written by the user in source code
+ -- The module isn't necessarily the module where
+ -- the thing is defined; just the one from which it
+ -- is imported
+
+ | Orig ModuleName -- This is an *original* name; the module is the place
+ -- where the thing was defined
\end{code}
\end{code}
@@
-68,6
+74,7
@@
data Qual = Unqual
\begin{code}
rdrNameModule :: RdrName -> ModuleName
rdrNameModule (RdrName (Qual m) _) = m
\begin{code}
rdrNameModule :: RdrName -> ModuleName
rdrNameModule (RdrName (Qual m) _) = m
+rdrNameModule (RdrName (Orig m) _) = m
rdrNameOcc :: RdrName -> OccName
rdrNameOcc (RdrName _ occ) = occ
rdrNameOcc :: RdrName -> OccName
rdrNameOcc (RdrName _ occ) = occ
@@
-84,24
+91,23
@@
mkRdrUnqual occ = RdrName Unqual occ
mkRdrQual :: ModuleName -> OccName -> RdrName
mkRdrQual mod occ = RdrName (Qual mod) occ
mkRdrQual :: ModuleName -> OccName -> RdrName
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)
+mkRdrOrig :: ModuleName -> OccName -> RdrName
+mkRdrOrig mod occ = RdrName (Orig mod) occ
-mkSrcQual :: NameSpace -> (UserFS, UserFS) -> RdrName
-mkSrcQual sp (m, n) = RdrName (Qual (mkModuleNameFS m)) (mkSrcOccFS sp n)
+mkIfaceOrig :: NameSpace -> (EncodedFS, EncodedFS) -> RdrName
+mkIfaceOrig ns (m,n) = RdrName (Orig (mkSysModuleNameFS m)) (mkSysOccFS ns n)
- -- These two are used when parsing interface files
- -- They do not encode the module and occurrence name
-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 (mkSysModuleNameFS m)) (mkSysOccFS sp n)
+ -- These two are used when parsing source files
+ -- They do encode the module and occurrence names
+mkUnqual :: NameSpace -> FAST_STRING -> RdrName
+mkUnqual sp n = RdrName Unqual (mkOccFS sp n)
-mkPreludeQual :: NameSpace -> ModuleName -> FAST_STRING -> RdrName
-mkPreludeQual sp mod n = RdrName (Qual mod) (mkSrcOccFS sp n)
+mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
+mkQual sp (m, n) = RdrName (Qual (mkModuleNameFS m)) (mkOccFS sp n)
+
+mkOrig :: NameSpace -> ModuleName -> UserFS -> RdrName
+mkOrig sp mod n = RdrName (Orig mod) (mkOccFS sp n)
qualifyRdrName :: ModuleName -> RdrName -> RdrName
-- Sets the module name of a RdrName, even if it has one already
qualifyRdrName :: ModuleName -> RdrName -> RdrName
-- Sets the module name of a RdrName, even if it has one already
@@
-117,8
+123,8
@@
mkRdrNameWkr (RdrName qual occ) = RdrName qual (mkWorkerOcc occ)
-- the renamer. We can't just put "error..." because
-- we sometimes want to print out stuff after reading but
-- before renaming
-- 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}
\end{code}
@@
-129,7
+135,11
@@
isRdrTyVar (RdrName _ occ) = isTvOcc occ
isUnqual (RdrName Unqual _) = True
isUnqual other = False
isUnqual (RdrName Unqual _) = True
isUnqual other = False
-isQual rdr_name = not (isUnqual rdr_name)
+isQual (RdrName (Qual _) _) = True
+isQual _ = False
+
+isOrig (RdrName (Orig _) _) = True
+isOrig other = False
\end{code}
\end{code}
@@
-143,8
+153,9
@@
isQual rdr_name = not (isUnqual rdr_name)
instance Outputable RdrName where
ppr (RdrName qual occ) = pp_qual qual <> ppr occ
where
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
+ pp_qual (Orig mod) = ppr mod <> dot
pprUnqualRdrName (RdrName qual occ) = ppr occ
pprUnqualRdrName (RdrName qual occ) = ppr occ
@@
-162,10
+173,12
@@
instance Ord RdrName where
= (o1 `compare` o2) `thenCmp`
(q1 `cmpQual` q2)
= (o1 `compare` o2) `thenCmp`
(q1 `cmpQual` q2)
-cmpQual Unqual Unqual = EQ
-cmpQual Unqual (Qual _) = LT
-cmpQual (Qual _) Unqual = GT
-cmpQual (Qual m1) (Qual m2) = m1 `compare` m2
+cmpQual Unqual Unqual = EQ
+cmpQual (Qual m1) (Qual m2) = m1 `compare` m2
+cmpQual (Orig m1) (Orig m2) = m1 `compare` m2
+cmpQual Unqual _ = LT
+cmpQual (Qual _) (Orig _) = LT
+cmpQual _ _ = GT
\end{code}
\end{code}
@@
-185,6
+198,8
@@
addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
extendRdrEnv :: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
rdrEnvToList :: RdrNameEnv a -> [(RdrName, a)]
rdrEnvElts :: RdrNameEnv a -> [a]
extendRdrEnv :: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
rdrEnvToList :: RdrNameEnv a -> [(RdrName, a)]
rdrEnvElts :: RdrNameEnv a -> [a]
+elemRdrEnv :: RdrName -> RdrNameEnv a -> Bool
+foldRdrEnv :: (RdrName -> a -> b -> b) -> b -> RdrNameEnv a -> b
emptyRdrEnv = emptyFM
lookupRdrEnv = lookupFM
emptyRdrEnv = emptyFM
lookupRdrEnv = lookupFM
@@
-192,4
+207,6
@@
addListToRdrEnv = addListToFM
rdrEnvElts = eltsFM
extendRdrEnv = addToFM
rdrEnvToList = fmToList
rdrEnvElts = eltsFM
extendRdrEnv = addToFM
rdrEnvToList = fmToList
+elemRdrEnv = elemFM
+foldRdrEnv = foldFM
\end{code}
\end{code}