X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FName.lhs;h=2cd0ef0e82837f757b1e2e510b19b03852006cb7;hb=c85373c7dd8034f427c010490f15590deb589490;hp=2dcc009ff7c3f968858d57b98c2e05e436f85044;hpb=d364541154457a49e3c35d671d7a1b57c9c4cca3;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index 2dcc009..2cd0ef0 100644 --- a/ghc/compiler/basicTypes/Name.lhs +++ b/ghc/compiler/basicTypes/Name.lhs @@ -10,9 +10,9 @@ module Name ( -- The Name type Name, -- Abstract - mkLocalName, mkSysLocalName, mkCCallName, + mkLocalName, mkSysLocalName, mkFCallName, mkIPName, - mkDerivedName, mkGlobalName, mkKnownKeyGlobal, mkWiredInName, + mkGlobalName, mkKnownKeyGlobal, mkWiredInName, nameUnique, setNameUnique, nameOccName, nameModule, nameModule_maybe, @@ -20,23 +20,15 @@ module Name ( toRdrName, hashName, globaliseName, localiseName, - nameSrcLoc, nameIsLocallyDefined, isDllName, nameIsFrom, nameIsLocalOrFrom, + nameSrcLoc, isSystemName, isLocalName, isGlobalName, isExternallyVisibleName, - isTyVarName, + isTyVarName, isDllName, + nameIsLocalOrFrom, isHomePackageName, - -- Environment - NameEnv, mkNameEnv, - emptyNameEnv, unitNameEnv, nameEnvElts, - extendNameEnv_C, extendNameEnv, foldNameEnv, filterNameEnv, - plusNameEnv, plusNameEnv_C, extendNameEnv, extendNameEnvList, - lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, elemNameEnv, - - -- Class NamedThing and overloaded friends NamedThing(..), - getSrcLoc, getOccString, toRdrName, - isFrom, isLocalOrFrom + getSrcLoc, getOccString, toRdrName ) where #include "HsVersions.h" @@ -46,10 +38,8 @@ import Module ( Module, moduleName, mkVanillaModule, isHomeModule ) import RdrName ( RdrName, mkRdrOrig, mkRdrUnqual, rdrNameOcc, rdrNameModule ) import CmdLineOpts ( opt_Static ) import SrcLoc ( builtinSrcLoc, noSrcLoc, SrcLoc ) -import Unique ( Unique, Uniquable(..), u2i, pprUnique, pprUnique10 ) +import Unique ( Unique, Uniquable(..), u2i, pprUnique ) import FastTypes -import Maybes ( expectJust ) -import UniqFM import Outputable \end{code} @@ -121,26 +111,29 @@ nameModule_maybe name = Nothing \end{code} \begin{code} -nameIsLocallyDefined :: Name -> Bool -nameIsFrom :: Module -> Name -> Bool nameIsLocalOrFrom :: Module -> Name -> Bool isLocalName :: Name -> Bool -- Not globals isGlobalName :: Name -> Bool isSystemName :: Name -> Bool isExternallyVisibleName :: Name -> Bool +isHomePackageName :: Name -> Bool isGlobalName (Name {n_sort = Global _}) = True isGlobalName other = False isLocalName name = not (isGlobalName name) -nameIsLocallyDefined name = isLocalName name - nameIsLocalOrFrom from (Name {n_sort = Global mod}) = mod == from nameIsLocalOrFrom from other = True -nameIsFrom from (Name {n_sort = Global mod}) = mod == from -nameIsFrom from other = pprPanic "nameIsFrom" (ppr other) +isHomePackageName (Name {n_sort = Global mod}) = isHomeModule mod +isHomePackageName other = True -- Local and system names + +isDllName :: Name -> Bool -- Does this name refer to something in a different DLL? +isDllName nm = not opt_Static && not (isHomePackageName nm) + +isTyVarName :: Name -> Bool +isTyVarName name = isTvOcc (nameOccName name) -- Global names are by definition those that are visible -- outside the module, *as seen by the linker*. Externally visible @@ -187,10 +180,10 @@ mkSysLocalName :: Unique -> UserFS -> Name mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = System, n_occ = mkVarOcc fs, n_loc = noSrcLoc } -mkCCallName :: Unique -> EncodedString -> Name +mkFCallName :: Unique -> EncodedString -> Name -- The encoded string completely describes the ccall -mkCCallName uniq str = Name { n_uniq = uniq, n_sort = Local, - n_occ = mkCCallOcc str, n_loc = noSrcLoc } +mkFCallName uniq str = Name { n_uniq = uniq, n_sort = Local, + n_occ = mkFCallOcc str, n_loc = noSrcLoc } mkIPName :: Unique -> OccName -> Name mkIPName uniq occ @@ -198,14 +191,6 @@ mkIPName uniq occ n_sort = Local, n_occ = occ, n_loc = noSrcLoc } - ---------------------------------------------------------------------- -mkDerivedName :: (OccName -> OccName) - -> Name -- Base name - -> Unique -- New unique - -> Name -- Result is always a value name - -mkDerivedName f name uniq = name {n_uniq = uniq, n_occ = f (n_occ name)} \end{code} \begin{code} @@ -246,17 +231,6 @@ nameRdrName :: Name -> RdrName -- and an unqualified name just for Locals nameRdrName (Name { n_occ = occ, n_sort = Global mod }) = mkRdrOrig (moduleName mod) occ nameRdrName (Name { n_occ = occ }) = mkRdrUnqual occ - -isDllName :: Name -> Bool - -- Does this name refer to something in a different DLL? -isDllName nm = not opt_Static && - not (isLocalName nm) && -- isLocalName test needed 'cos - not (isHomeModule (nameModule nm)) -- nameModule won't work on local names - - - -isTyVarName :: Name -> Bool -isTyVarName name = isTvOcc (nameOccName name) \end{code} @@ -292,52 +266,6 @@ instance NamedThing Name where %************************************************************************ %* * -\subsection{Name environment} -%* * -%************************************************************************ - -\begin{code} -type NameEnv a = UniqFM a -- Domain is Name - -emptyNameEnv :: NameEnv a -mkNameEnv :: [(Name,a)] -> NameEnv a -nameEnvElts :: NameEnv a -> [a] -extendNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a -extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a -plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a -plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a -extendNameEnvList:: NameEnv a -> [(Name,a)] -> NameEnv a -delFromNameEnv :: NameEnv a -> Name -> NameEnv a -elemNameEnv :: Name -> NameEnv a -> Bool -unitNameEnv :: Name -> a -> NameEnv a -lookupNameEnv :: NameEnv a -> Name -> Maybe a -lookupNameEnv_NF :: NameEnv a -> Name -> a -mapNameEnv :: (a->b) -> NameEnv a -> NameEnv b -foldNameEnv :: (a -> b -> b) -> b -> NameEnv a -> b -filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt - -emptyNameEnv = emptyUFM -foldNameEnv = foldUFM -mkNameEnv = listToUFM -nameEnvElts = eltsUFM -extendNameEnv_C = addToUFM_C -extendNameEnv = addToUFM -plusNameEnv = plusUFM -plusNameEnv_C = plusUFM_C -extendNameEnvList= addListToUFM -delFromNameEnv = delFromUFM -elemNameEnv = elemUFM -mapNameEnv = mapUFM -unitNameEnv = unitUFM -filterNameEnv = filterUFM - -lookupNameEnv = lookupUFM -lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupUFM env n) -\end{code} - - -%************************************************************************ -%* * \subsection{Pretty printing} %* * %************************************************************************ @@ -366,14 +294,14 @@ pprGlobal sty name uniq mod occ pprLocal sty uniq occ | codeStyle sty = pprUnique uniq | debugStyle sty = pprOccName occ <> - text "{-" <> pprUnique10 uniq <> text "-}" + text "{-" <> pprUnique uniq <> text "-}" | otherwise = pprOccName occ -- User and Iface styles -- Like Local, except that we only omit the unique in Iface style pprSysLocal sty uniq occ | codeStyle sty = pprUnique uniq - | ifaceStyle sty = pprOccName occ -- The tidy phase has ensured that OccNames - -- are enough + | ifaceStyle sty = pprOccName occ -- The tidy phase has ensured + -- that OccNames are enough | otherwise = pprOccName occ <> char '_' <> pprUnique uniq -- If the tidy phase hasn't run, the OccName -- is unlikely to be informative (like 's'), @@ -398,13 +326,9 @@ class NamedThing a where getSrcLoc :: NamedThing a => a -> SrcLoc getOccString :: NamedThing a => a -> String toRdrName :: NamedThing a => a -> RdrName -isFrom :: NamedThing a => Module -> a -> Bool -isLocalOrFrom :: NamedThing a => Module -> a -> Bool getSrcLoc = nameSrcLoc . getName getOccString = occNameString . getOccName toRdrName = nameRdrName . getName -isFrom mod x = nameIsFrom mod (getName x) -isLocalOrFrom mod x = nameIsLocalOrFrom mod ( getName x) \end{code}