[project @ 2000-10-31 17:30:16 by simonpj]

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

diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs
index 5c0fc0a..a3572ba 100644 (file)
--- a/ghc/compiler/basicTypes/RdrName.lhs
+++ b/ghc/compiler/basicTypes/RdrName.lhs
@@ -9,20 +9,19 @@ module RdrName (
        RdrName,
 
        -- Construction
-       mkRdrUnqual, mkRdrQual,
-       mkSrcUnqual, mkSrcQual, 
-       mkSysUnqual, mkSysQual,
-       mkPreludeQual, qualifyRdrName, mkRdrNameWkr,
+       mkRdrUnqual, mkRdrQual, mkRdrOrig, mkRdrIfaceUnqual,
+       mkUnqual, mkQual, mkIfaceOrig, mkOrig,
+       qualifyRdrName, mkRdrNameWkr,
        dummyRdrVarName, dummyRdrTcName,
 
        -- Destruction
        rdrNameModule, rdrNameOcc, setRdrNameOcc,
-       isRdrDataCon, isRdrTyVar, isQual, isUnqual,
+       isRdrDataCon, isRdrTyVar, isQual, isSourceQual, isUnqual, isIface,
 
        -- Environment
        RdrNameEnv, 
        emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts, 
-       extendRdrEnv, rdrEnvToList,
+       extendRdrEnv, rdrEnvToList, elemRdrEnv,
 
        -- Printing;    instance Outputable RdrName
        pprUnqualRdrName 
@@ -31,13 +30,13 @@ module RdrName (
 #include "HsVersions.h"
 
 import OccName ( NameSpace, tcName,
-                 OccName, UserFS,
+                 OccName, UserFS, EncodedFS,
                  mkSysOccFS,
-                 mkSrcOccFS, mkSrcVarOcc,
+                 mkOccFS, mkVarOcc,
                  isDataOcc, isTvOcc, mkWorkerOcc
                )
-import Module   ( ModuleName, pprModuleName,
-                 mkSysModuleFS, mkSrcModuleFS
+import Module   ( ModuleName,
+                 mkSysModuleNameFS, mkModuleNameFS
                )
 import FiniteMap
 import Outputable
@@ -55,7 +54,18 @@ import Util  ( thenCmp )
 data RdrName = RdrName Qual OccName
 
 data Qual = Unqual
-         | Qual ModuleName     -- The (encoded) module name
+
+         | IfaceUnqual         -- An unqualified name from an interface file;
+                               -- implicitly its module is that of the enclosing
+                               -- interface file; don't look it up in the environment
+
+         | 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}
 
 
@@ -68,6 +78,7 @@ data Qual = Unqual
 \begin{code}
 rdrNameModule :: RdrName -> ModuleName
 rdrNameModule (RdrName (Qual m) _) = m
+rdrNameModule (RdrName (Orig m) _) = m
 
 rdrNameOcc :: RdrName -> OccName
 rdrNameOcc (RdrName _ occ) = occ
@@ -81,27 +92,29 @@ setRdrNameOcc (RdrName q _) occ = RdrName q occ
 mkRdrUnqual :: OccName -> RdrName
 mkRdrUnqual occ = RdrName Unqual occ
 
+mkRdrIfaceUnqual :: OccName -> RdrName
+mkRdrIfaceUnqual occ = RdrName IfaceUnqual 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 (mkSrcModuleFS 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 (mkSysModuleFS 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)
+
+mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
+mkQual sp (m, n) = RdrName (Qual (mkModuleNameFS m)) (mkOccFS sp n)
 
-mkPreludeQual :: NameSpace -> ModuleName -> FAST_STRING -> RdrName
-mkPreludeQual sp mod n = RdrName (Qual mod) (mkSrcOccFS 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
@@ -117,8 +130,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
-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}
 
 
@@ -126,10 +139,18 @@ dummyRdrTcName  = RdrName Unqual (mkSrcOccFS tcName SLIT("TC-DUMMY"))
 isRdrDataCon (RdrName _ occ) = isDataOcc occ
 isRdrTyVar   (RdrName _ occ) = isTvOcc occ
 
-isUnqual (RdrName Unqual _) = True
-isUnqual other             = False
+isUnqual (RdrName Unqual _)      = True
+isUnqual (RdrName IfaceUnqual _) = True
+isUnqual other                  = False
 
 isQual rdr_name = not (isUnqual rdr_name)
+
+isSourceQual (RdrName (Qual _) _) = True
+isSourceQual _                   = False
+
+isIface (RdrName (Orig _)    _) = True
+isIface (RdrName IfaceUnqual _) = True
+isIface other                  = False
 \end{code}
 
 
@@ -143,8 +164,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) = pprModuleName mod <> dot
+                            pp_qual Unqual      = empty
+                            pp_qual IfaceUnqual = empty
+                            pp_qual (Qual mod)  = ppr mod <> dot
+                            pp_qual (Orig mod)  = ppr mod <> dot
 
 pprUnqualRdrName (RdrName qual occ) = ppr occ
 
@@ -162,10 +185,15 @@ instance Ord RdrName where
        = (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 IfaceUnqual IfaceUnqual = EQ
+cmpQual (Qual m1)   (Qual m2)   = m1 `compare` m2
+cmpQual (Orig m1)   (Orig m2)   = m1 `compare` m2
+cmpQual Unqual      _          = LT
+cmpQual IfaceUnqual (Qual _)   = LT
+cmpQual IfaceUnqual (Orig _)   = LT
+cmpQual (Qual _)    (Orig _)    = LT
+cmpQual _          _           = GT
 \end{code}
 
 
@@ -185,6 +213,7 @@ addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
 extendRdrEnv   :: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
 rdrEnvToList    :: RdrNameEnv a -> [(RdrName, a)]
 rdrEnvElts     :: RdrNameEnv a -> [a]
+elemRdrEnv     :: RdrName -> RdrNameEnv a -> Bool
 
 emptyRdrEnv  = emptyFM
 lookupRdrEnv = lookupFM
@@ -192,4 +221,5 @@ addListToRdrEnv = addListToFM
 rdrEnvElts     = eltsFM
 extendRdrEnv    = addToFM
 rdrEnvToList    = fmToList
+elemRdrEnv      = elemFM
 \end{code}