X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FName.lhs;h=ff8096a9298862f0586d258cf02eeac320eee2bc;hb=3c1b89ab88b2f349a698e9eb05d0e971a670f245;hp=ac47387290345745293d1b4295d3b797aca41770;hpb=be33dbc967b4915cfdb0307ae1b7ae3cee651b8c;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index ac47387..ff8096a 100644 --- a/ghc/compiler/basicTypes/Name.lhs +++ b/ghc/compiler/basicTypes/Name.lhs @@ -1,147 +1,67 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[Name]{@Name@: to transmit name info from renamer to typechecker} \begin{code} module Name ( - -- Re-export the Module type - Module, - pprModule, moduleString, - - -- The OccName type - OccName(..), - pprOccName, occNameString, occNameFlavour, - isTvOcc, isTCOcc, isVarOcc, prefixOccName, - uniqToOccName, + -- Re-export the OccName stuff + module OccName, -- The Name type Name, -- Abstract - mkLocalName, mkSysLocalName, - - mkCompoundName, mkGlobalName, - + mkLocalName, mkImportedLocalName, mkSysLocalName, mkCCallName, + mkTopName, mkIPName, + mkDerivedName, mkGlobalName, mkKnownKeyGlobal, mkWiredInIdName, mkWiredInTyConName, - maybeWiredInIdName, maybeWiredInTyConName, - isWiredInName, + mkUnboundName, isUnboundName, - nameUnique, changeUnique, setNameProvenance, getNameProvenance, - setNameVisibility, - nameOccName, nameString, nameModule, + maybeWiredInIdName, maybeWiredInTyConName, + isWiredInName, hashName, - isExportedName, nameSrcLoc, - isLocallyDefinedName, + nameUnique, setNameUnique, setNameProvenance, getNameProvenance, setNameImportReason, + tidyTopName, + nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule, toRdrName, - isLocalName, + isUserExportedName, isUserImportedName, isUserImportedExplicitlyName, + maybeUserImportedFrom, + nameSrcLoc, isLocallyDefinedName, isDllName, - pprNameProvenance, + isSystemName, isLocalName, isGlobalName, isExternallyVisibleName, + + -- Environment + NameEnv, + emptyNameEnv, unitNameEnv, nameEnvElts, + addToNameEnv_C, addToNameEnv, addListToNameEnv, + plusNameEnv, plusNameEnv_C, extendNameEnv, + lookupNameEnv, delFromNameEnv, elemNameEnv, - -- Sets of Names - NameSet, - emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets, - minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, isEmptyNameSet, - -- Misc - Provenance(..), pprProvenance, - ExportFlag(..), - PrintUnqualified, + -- Provenance + Provenance(..), ImportReason(..), pprProvenance, + ExportFlag(..), PrintUnqualified, + pprNameProvenance, hasBetterProv, -- Class NamedThing and overloaded friends NamedThing(..), - modAndOcc, isExported, - getSrcLoc, isLocallyDefined, getOccString + getSrcLoc, isLocallyDefined, getOccString, toRdrName ) where #include "HsVersions.h" -import {-# SOURCE #-} Id ( Id ) -import {-# SOURCE #-} TyCon ( TyCon ) +import {-# SOURCE #-} Var ( Id, setIdName ) +import {-# SOURCE #-} TyCon ( TyCon, setTyConName ) -import CStrings ( identToC ) -import CmdLineOpts ( opt_PprStyle_All, opt_OmitInterfacePragmas, opt_EnsureSplittableC ) -import BasicTypes ( Module, IfaceFlavour(..), moduleString, pprModule ) +import OccName -- All of it +import Module ( Module, moduleName, pprModule, mkVanillaModule, isLocalModule ) +import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule ) +import CmdLineOpts ( opt_Static, opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC ) -import Lex ( isLexConId ) import SrcLoc ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc ) -import Unique ( pprUnique, showUnique, Unique, Uniquable(..) ) -import UniqSet ( UniqSet(..), emptyUniqSet, unitUniqSet, unionUniqSets, uniqSetToList, - isEmptyUniqSet, unionManyUniqSets, minusUniqSet, mkUniqSet, - elementOfUniqSet, addListToUniqSet, addOneToUniqSet - ) -import UniqFM ( UniqFM ) +import Unique ( pprUnique, Unique, Uniquable(..), hasKey, unboundKey, u2i ) +import UniqFM import Outputable -\end{code} - - -%************************************************************************ -%* * -\subsection[Name-pieces-datatypes]{The @OccName@ datatypes} -%* * -%************************************************************************ - -\begin{code} -data OccName = VarOcc FAST_STRING -- Variables and data constructors - | TvOcc FAST_STRING -- Type variables - | TCOcc FAST_STRING -- Type constructors and classes - -pprOccName :: OccName -> SDoc -pprOccName n = getPprStyle $ \ sty -> - if codeStyle sty - then identToC (occNameString n) - else ptext (occNameString n) - -occNameString :: OccName -> FAST_STRING -occNameString (VarOcc s) = s -occNameString (TvOcc s) = s -occNameString (TCOcc s) = s - -prefixOccName :: FAST_STRING -> OccName -> OccName -prefixOccName prefix (VarOcc s) = VarOcc (prefix _APPEND_ s) -prefixOccName prefix (TvOcc s) = TvOcc (prefix _APPEND_ s) -prefixOccName prefix (TCOcc s) = TCOcc (prefix _APPEND_ s) - --- occNameFlavour is used only to generate good error messages, so it doesn't matter --- that the VarOcc case isn't mega-efficient. We could have different Occ constructors for --- data constructors and values, but that makes everything else a bit more complicated. -occNameFlavour :: OccName -> String -occNameFlavour (VarOcc s) | isLexConId s = "Data constructor" - | otherwise = "Value" -occNameFlavour (TvOcc s) = "Type variable" -occNameFlavour (TCOcc s) = "Type constructor or class" - -isVarOcc, isTCOcc, isTvOcc :: OccName -> Bool -isVarOcc (VarOcc s) = True -isVarOcc other = False - -isTvOcc (TvOcc s) = True -isTvOcc other = False - -isTCOcc (TCOcc s) = True -isTCOcc other = False - -instance Eq OccName where - a == b = case (a `compare` b) of { EQ -> True; _ -> False } - a /= b = case (a `compare` b) of { EQ -> False; _ -> True } - -instance Ord OccName where - a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False } - a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False } - a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True } - a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True } - compare a b = cmpOcc a b - -(VarOcc s1) `cmpOcc` (VarOcc s2) = s1 `compare` s2 -(VarOcc s1) `cmpOcc` other2 = LT - -(TvOcc s1) `cmpOcc` (VarOcc s2) = GT -(TvOcc s1) `cmpOcc` (TvOcc s2) = s1 `compare` s2 -(TvOcc s1) `cmpOcc` other = LT - -(TCOcc s1) `cmpOcc` (TCOcc s2) = s1 `compare` s2 -(TCOcc s1) `cmpOcc` other = GT - -instance Outputable OccName where - ppr = pprOccName +import GlaExts \end{code} @@ -152,15 +72,18 @@ instance Outputable OccName where %************************************************************************ \begin{code} -data Name - = Local Unique - OccName - SrcLoc - - | Global Unique - Module -- The defining module - OccName -- Its name in that module - Provenance -- How it was defined +data Name = Name { + n_sort :: NameSort, -- What sort of name it is + n_uniq :: Unique, + n_occ :: OccName, -- Its occurrence name + n_prov :: Provenance -- How it was made + } + +data NameSort + = Local + | Global Module + | WiredInId Module Id + | WiredInTyCon Module TyCon \end{code} Things with a @Global@ name are given C static labels, so they finally @@ -169,107 +92,138 @@ in the form M.n. If originally-local things have this property they must be made @Global@ first. \begin{code} -data Provenance - = NoProvenance - - | LocalDef -- Defined locally - SrcLoc -- Defn site - ExportFlag -- Whether it's exported - - | NonLocalDef -- Defined non-locally - SrcLoc -- Defined non-locally; src-loc gives defn site - IfaceFlavour -- Whether the defn site is an .hi-boot file or not - PrintUnqualified - - | WiredInTyCon TyCon -- There's a wired-in version - | WiredInId Id -- ...ditto... - -type PrintUnqualified = Bool -- True <=> the unqualified name of this thing is - -- in scope in this module, so print it unqualified - -- in error messages -\end{code} - -Something is "Exported" if it may be mentioned by another module without -warning. The crucial thing about Exported things is that they must -never be dropped as dead code, even if they aren't used in this module. -Furthermore, being Exported means that we can't see all call sites of the thing. - -Exported things include: - - explicitly exported Ids, including data constructors, class method selectors - - dfuns from instance decls - -Being Exported is *not* the same as finally appearing in the .o file's -symbol table. For example, a local Id may be mentioned in an Exported -Id's unfolding in the interface file, in which case the local Id goes -out too. - -\begin{code} -data ExportFlag = Exported | NotExported -\end{code} +mkLocalName :: Unique -> OccName -> SrcLoc -> Name +mkLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ, + n_prov = LocalDef loc NotExported } + -- NB: You might worry that after lots of huffing and + -- puffing we might end up with two local names with distinct + -- uniques, but the same OccName. Indeed we can, but that's ok + -- * the insides of the compiler don't care: they use the Unique + -- * when printing for -ddump-xxx you can switch on -dppr-debug to get the + -- uniques if you get confused + -- * for interface files we tidyCore first, which puts the uniques + -- into the print name (see setNameVisibility below) + +mkImportedLocalName :: Unique -> OccName -> SrcLoc -> Name + -- Just the same as mkLocalName, except the provenance is different + -- Reason: this flags the name as one that came in from an interface file. + -- This is useful when trying to decide which of two type variables + -- should 'win' when unifying them. + -- NB: this is only for non-top-level names, so we use ImplicitImport +mkImportedLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ, + n_prov = NonLocalDef ImplicitImport True } -\begin{code} -mkLocalName :: Unique -> OccName -> SrcLoc -> Name -mkLocalName = Local mkGlobalName :: Unique -> Module -> OccName -> Provenance -> Name -mkGlobalName = Global - -mkSysLocalName :: Unique -> FAST_STRING -> SrcLoc -> Name -mkSysLocalName uniq str loc = Local uniq (VarOcc str) loc - -mkWiredInIdName :: Unique -> Module -> FAST_STRING -> Id -> Name -mkWiredInIdName uniq mod occ id - = Global uniq mod (VarOcc occ) (WiredInId id) - +mkGlobalName uniq mod occ prov = Name { n_uniq = uniq, n_sort = Global mod, + n_occ = occ, n_prov = prov } + + +mkKnownKeyGlobal :: (RdrName, Unique) -> Name +mkKnownKeyGlobal (rdr_name, uniq) + = mkGlobalName uniq (mkVanillaModule (rdrNameModule rdr_name)) + (rdrNameOcc rdr_name) + systemProvenance + +mkSysLocalName :: Unique -> UserFS -> Name +mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = Local, + n_occ = mkSrcVarOcc fs, n_prov = systemProvenance } + +mkCCallName :: 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_prov = NonLocalDef ImplicitImport True } + +mkTopName :: Unique -> Module -> FAST_STRING -> Name + -- Make a top-level name; make it Global if top-level + -- things should be externally visible; Local otherwise + -- This chap is only used *after* the tidyCore phase + -- Notably, it is used during STG lambda lifting + -- + -- We have to make sure that the name is globally unique + -- and we don't have tidyCore to help us. So we append + -- the unique. Hack! Hack! +mkTopName uniq mod fs + = Name { n_uniq = uniq, + n_sort = mk_top_sort mod, + n_occ = mkSrcVarOcc (_PK_ ((_UNPK_ fs) ++ show uniq)), + n_prov = LocalDef noSrcLoc NotExported } + +mkIPName :: Unique -> OccName -> Name +mkIPName uniq occ + = Name { n_uniq = uniq, + n_sort = Local, + n_occ = occ, + -- ZZ is this an appropriate provinence? + n_prov = SystemProv } + +------------------------- Wired in names ------------------------- + +mkWiredInIdName :: Unique -> Module -> OccName -> Id -> Name +mkWiredInIdName uniq mod occ id = Name { n_uniq = uniq, n_sort = WiredInId mod id, + n_occ = occ, n_prov = SystemProv } + +-- mkWiredInTyConName takes a FAST_STRING instead of +-- an OccName, which is a bit yukky but that's what the +-- clients find easiest. mkWiredInTyConName :: Unique -> Module -> FAST_STRING -> TyCon -> Name -mkWiredInTyConName uniq mod occ tycon - = Global uniq mod (TCOcc occ) (WiredInTyCon tycon) - +mkWiredInTyConName uniq mod fs tycon + = Name { n_uniq = uniq, n_sort = WiredInTyCon mod tycon, + n_occ = mkSrcOccFS tcName fs, n_prov = SystemProv } -mkCompoundName :: (FAST_STRING -> FAST_STRING) -- Occurrence-name modifier - -> Unique -- New unique - -> Name -- Base name (must be a Global) - -> Name -- Result is always a value name -mkCompoundName str_fn uniq (Global _ mod occ prov) - = Global uniq mod new_occ prov - where - new_occ = VarOcc (str_fn (occNameString occ)) -- Always a VarOcc +--------------------------------------------------------------------- +mkDerivedName :: (OccName -> OccName) + -> Name -- Base name + -> Unique -- New unique + -> Name -- Result is always a value name -mkCompoundName str_fn uniq (Local _ occ loc) - = Local uniq (VarOcc (str_fn (occNameString occ))) loc +mkDerivedName f name uniq = name {n_uniq = uniq, n_occ = f (n_occ name)} +-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly +-- during compiler debugging. +mkUnboundName :: RdrName -> Name +mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc -setNameProvenance :: Name -> Provenance -> Name - -- setNameProvenance used to only change the provenance of Implicit-provenance things, - -- but that gives bad error messages for names defined twice in the same - -- module, so I changed it to set the provenance of *any* global (SLPJ Jun 97) -setNameProvenance (Global uniq mod occ _) prov = Global uniq mod occ prov -setNameProvenance other_name prov = other_name - -getNameProvenance :: Name -> Provenance -getNameProvenance (Global uniq mod occ prov) = prov -getNameProvenance (Local uniq occ locn) = LocalDef locn NotExported +isUnboundName :: Name -> Bool +isUnboundName name = name `hasKey` unboundKey +\end{code} +\begin{code} -- When we renumber/rename things, we need to be -- able to change a Name's Unique to match the cached -- one in the thing it's the name of. If you know what I mean. -changeUnique (Local _ n l) u = Local u n l -changeUnique (Global _ mod occ prov) u = Global u mod occ prov +setNameUnique name uniq = name {n_uniq = uniq} + +setNameOcc :: Name -> OccName -> Name + -- Give the thing a new OccName, *and* + -- record that it's no longer a sys-local + -- This is used by the tidy-up pass +setNameOcc name occ = name {n_occ = occ} + +setNameModule :: Name -> Module -> Name +setNameModule name mod = name {n_sort = set (n_sort name)} + where + set (Global _) = Global mod + set (WiredInId _ id) = WiredInId mod id + set (WiredInTyCon _ tycon) = WiredInTyCon mod tycon \end{code} -setNameVisibility is applied to names in the final program -The Maybe Module argument is (Just mod) for top-level values, -and Nothing for all others (local values and type variables) +%************************************************************************ +%* * +\subsection{Setting provenance and visibility +%* * +%************************************************************************ + +tidyTopName is applied to top-level names in the final program For top-level things, it globalises Local names (if all top-level things should be visible) and localises non-exported Global names (if only exported things should be visible) -For nested things it localises Global names. - In all cases except an exported global, it gives it a new occurrence name. The "visibility" here concerns whether the .o file's symbol table @@ -297,34 +251,147 @@ are exported. But also: top-level defns externally visible \begin{code} -setNameVisibility :: Maybe Module -> Unique -> Name -> Name +tidyTopName :: Module -> TidyOccEnv -> Name -> (TidyOccEnv, Name) +tidyTopName mod env name + = (env', name') + where + (env', occ') = tidyOccName env (n_occ name) -setNameVisibility maybe_mod occ_uniq name@(Global uniq mod occ (LocalDef loc NotExported)) - | not all_toplev_ids_visible || not_top_level maybe_mod - = Local uniq (uniqToOccName occ_uniq) loc -- Localise Global name + name' = Name { n_uniq = n_uniq name, n_sort = mk_top_sort mod, + n_occ = occ', n_prov = LocalDef noSrcLoc NotExported } -setNameVisibility maybe_mod occ_uniq name@(Global _ _ _ _) - = name -- Otherwise don't fiddle with Global +mk_top_sort mod | all_toplev_ids_visible = Global mod + | otherwise = Local -setNameVisibility (Just mod) occ_uniq (Local uniq occ loc) - | all_toplev_ids_visible - = Global uniq mod -- Globalise Local name - (uniqToOccName occ_uniq) - (LocalDef loc NotExported) +all_toplev_ids_visible = + not opt_OmitInterfacePragmas || -- Pragmas can make them visible + opt_EnsureSplittableC -- Splitting requires visiblilty +\end{code} -setNameVisibility maybe_mod occ_uniq (Local uniq occ loc) - = Local uniq (uniqToOccName occ_uniq) loc -- New OccName for Local -uniqToOccName uniq = VarOcc (_PK_ ('$':showUnique uniq)) - -- The "$" is to make sure that this OccName is distinct from all user-defined ones +\begin{code} +setNameProvenance :: Name -> Provenance -> Name + -- setNameProvenance used to only change the provenance of + -- Implicit-provenance things, but that gives bad error messages + -- for names defined twice in the same module, so I changed it to + -- set the provenance of *any* global (SLPJ Jun 97) +setNameProvenance name prov = name {n_prov = prov} -not_top_level (Just m) = False -not_top_level Nothing = True +getNameProvenance :: Name -> Provenance +getNameProvenance name = n_prov name -all_toplev_ids_visible = not opt_OmitInterfacePragmas || -- Pragmas can make them visible - opt_EnsureSplittableC -- Splitting requires visiblilty +setNameImportReason :: Name -> ImportReason -> Name +setNameImportReason name reason + = name { n_prov = new_prov } + where + -- It's important that we don't do the pattern matching + -- in the top-level clause, else we get a black hole in + -- the renamer. Rather a yukky constraint. There's only + -- one call, in RnNames + old_prov = n_prov name + new_prov = case old_prov of + NonLocalDef _ omit -> NonLocalDef reason omit + other -> old_prov \end{code} + +%************************************************************************ +%* * +\subsection{Provenance and export info} +%* * +%************************************************************************ + +\begin{code} +data Provenance + = LocalDef -- Defined locally + SrcLoc -- Defn site + ExportFlag -- Whether it's exported + + | NonLocalDef -- Defined non-locally + ImportReason + PrintUnqualified + + | SystemProv -- Either (a) a system-generated local with + -- a v short name OccName + -- or (b) a known-key global which should have a proper + -- provenance attached by the renamer +\end{code} + +Sys-provs are only used internally. When the compiler generates (say) +a fresh desguar variable it always calls it "ds", and of course it gets +a fresh unique. But when printing -ddump-xx dumps, we must print it with +its unique, because there'll be a lot of "ds" variables. + +Names with SystemProv differ in the following ways: + a) locals have unique attached when printing dumps + b) unifier eliminates sys tyvars in favour of user provs where possible + c) renamer replaces SystemProv with a better one + +Before anything gets printed in interface files or output code, it's +fed through a 'tidy' processor, which zaps the OccNames to have +unique names; and converts all sys-locals to user locals +If any desugarer sys-locals have survived that far, they get changed to +"ds1", "ds2", etc. + +\begin{code} +data ImportReason + = UserImport Module SrcLoc Bool -- Imported from module M on line L + -- Note the M may well not be the defining module + -- for this thing! + -- The Bool is true iff the thing was named *explicitly* in the import spec, + -- rather than being imported as part of a group; e.g. + -- import B + -- import C( T(..) ) + -- Here, everything imported by B, and the constructors of T + -- are not named explicitly; only T is named explicitly. + -- This info is used when warning of unused names. + + | ImplicitImport -- Imported implicitly for some other reason + + +type PrintUnqualified = Bool -- True <=> the unqualified name of this thing is + -- in scope in this module, so print it + -- unqualified in error messages + +data ExportFlag = Exported | NotExported +\end{code} + +Something is "Exported" if it may be mentioned by another module without +warning. The crucial thing about Exported things is that they must +never be dropped as dead code, even if they aren't used in this module. +Furthermore, being Exported means that we can't see all call sites of the thing. + +Exported things include: + + - explicitly exported Ids, including data constructors, + class method selectors + + - dfuns from instance decls + +Being Exported is *not* the same as finally appearing in the .o file's +symbol table. For example, a local Id may be mentioned in an Exported +Id's unfolding in the interface file, in which case the local Id goes +out too. + + +\begin{code} +systemProvenance :: Provenance +systemProvenance = SystemProv + +-- pprNameProvenance is used in error messages to say where a name came from +pprNameProvenance :: Name -> SDoc +pprNameProvenance name = pprProvenance (getNameProvenance name) + +pprProvenance :: Provenance -> SDoc +pprProvenance SystemProv = ptext SLIT("System") +pprProvenance (LocalDef loc _) = ptext SLIT("defined at") <+> ppr loc +pprProvenance (NonLocalDef ImplicitImport _) + = ptext SLIT("implicitly imported") +pprProvenance (NonLocalDef (UserImport mod loc _) _) + = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc +\end{code} + + %************************************************************************ %* * \subsection{Predicates and selectors} @@ -333,64 +400,115 @@ all_toplev_ids_visible = not opt_OmitInterfacePragmas || -- Pragmas can make th \begin{code} nameUnique :: Name -> Unique -nameModAndOcc :: Name -> (Module, OccName) -- Globals only nameOccName :: Name -> OccName nameModule :: Name -> Module -nameString :: Name -> FAST_STRING -- A.b form nameSrcLoc :: Name -> SrcLoc isLocallyDefinedName :: Name -> Bool -isExportedName :: Name -> Bool +isUserExportedName :: Name -> Bool isWiredInName :: Name -> Bool isLocalName :: Name -> Bool +isGlobalName :: Name -> Bool +isExternallyVisibleName :: Name -> Bool + + +hashName :: Name -> Int +hashName name = IBOX( u2i (nameUnique name) ) +nameUnique name = n_uniq name +nameOccName name = n_occ name -nameUnique (Local u _ _) = u -nameUnique (Global u _ _ _) = u +nameModule name = + case n_sort name of + Local -> pprPanic "nameModule" (ppr name) + x -> nameSortModule x -nameOccName (Local _ occ _) = occ -nameOccName (Global _ _ occ _) = occ +nameSortModule (Global mod) = mod +nameSortModule (WiredInId mod _) = mod +nameSortModule (WiredInTyCon mod _) = mod -nameModule (Global _ mod occ _) = mod +nameRdrName :: Name -> RdrName +-- Makes a qualified name for top-level (Global) names, whether locally defined or not +-- and an unqualified name just for Locals +nameRdrName (Name { n_sort = Local, n_occ = occ }) = mkRdrUnqual occ +nameRdrName (Name { n_sort = sort, n_occ = occ }) = mkRdrQual (moduleName (nameSortModule sort)) occ -nameModAndOcc (Global _ mod occ _) = (mod,occ) +ifaceNameRdrName :: Name -> RdrName +-- Makes a qualified naem for imported things, +-- and an unqualified one for local things +ifaceNameRdrName n | isLocallyDefined n = mkRdrUnqual (nameOccName n) + | otherwise = mkRdrQual (moduleName (nameModule n)) (nameOccName n) -nameString (Local _ occ _) = occNameString occ -nameString (Global _ mod occ _) = mod _APPEND_ SLIT(".") _APPEND_ occNameString occ +isUserExportedName (Name { n_prov = LocalDef _ Exported }) = True +isUserExportedName other = False -isExportedName (Global _ _ _ (LocalDef _ Exported)) = True -isExportedName other = False +isUserImportedExplicitlyName (Name { n_prov = NonLocalDef (UserImport _ _ explicit) _ }) = explicit +isUserImportedExplicitlyName other = False -nameSrcLoc (Local _ _ loc) = loc -nameSrcLoc (Global _ _ _ (LocalDef loc _)) = loc -nameSrcLoc (Global _ _ _ (NonLocalDef loc _ _)) = loc -nameSrcLoc (Global _ _ _ (WiredInTyCon _)) = mkBuiltinSrcLoc -nameSrcLoc (Global _ _ _ (WiredInId _)) = mkBuiltinSrcLoc -nameSrcLoc other = noSrcLoc +isUserImportedName (Name { n_prov = NonLocalDef (UserImport _ _ _) _ }) = True +isUserImportedName other = False + +maybeUserImportedFrom (Name { n_prov = NonLocalDef (UserImport m _ _) _ }) = Just m +maybeUserImportedFrom other = Nothing + +isDllName :: Name -> Bool + -- Does this name refer to something in a different DLL? +isDllName nm = not opt_Static && + not (isLocallyDefinedName nm) && + not (isLocalModule (nameModule nm)) + +nameSrcLoc name = provSrcLoc (n_prov name) + +provSrcLoc (LocalDef loc _) = loc +provSrcLoc (NonLocalDef (UserImport _ loc _) _) = loc +provSrcLoc other = noSrcLoc -isLocallyDefinedName (Local _ _ _) = True -isLocallyDefinedName (Global _ _ _ (LocalDef _ _)) = True -isLocallyDefinedName other = False +isLocallyDefinedName (Name {n_sort = Local}) = True -- Local (might have SystemProv) +isLocallyDefinedName (Name {n_prov = LocalDef _ _}) = True -- Global, but defined here +isLocallyDefinedName other = False -- Other -- Things the compiler "knows about" are in some sense -- "imported". When we are compiling the module where -- the entities are defined, we need to be able to pick -- them out, often in combination with isLocallyDefined. -isWiredInName (Global _ _ _ (WiredInTyCon _)) = True -isWiredInName (Global _ _ _ (WiredInId _)) = True -isWiredInName _ = False +isWiredInName (Name {n_sort = WiredInTyCon _ _}) = True +isWiredInName (Name {n_sort = WiredInId _ _}) = True +isWiredInName _ = False maybeWiredInIdName :: Name -> Maybe Id -maybeWiredInIdName (Global _ _ _ (WiredInId id)) = Just id -maybeWiredInIdName other = Nothing +maybeWiredInIdName (Name {n_sort = WiredInId _ id}) = Just id +maybeWiredInIdName other = Nothing maybeWiredInTyConName :: Name -> Maybe TyCon -maybeWiredInTyConName (Global _ _ _ (WiredInTyCon tc)) = Just tc -maybeWiredInTyConName other = Nothing - - -isLocalName (Local _ _ _) = True -isLocalName _ = False +maybeWiredInTyConName (Name {n_sort = WiredInTyCon _ tc}) = Just tc +maybeWiredInTyConName other = Nothing + + +isLocalName (Name {n_sort = Local}) = True +isLocalName _ = False + +isGlobalName (Name {n_sort = Local}) = False +isGlobalName other = True + +-- Global names are by definition those that are visible +-- outside the module, *as seen by the linker*. Externally visible +-- does not mean visible at the source level (that's isExported). +isExternallyVisibleName name = isGlobalName name + +hasBetterProv :: Name -> Name -> Bool +-- Choose +-- a local thing over an imported thing +-- a user-imported thing over a non-user-imported thing +-- an explicitly-imported thing over an implicitly imported thing +hasBetterProv n1 n2 + = case (n_prov n1, n_prov n2) of + (LocalDef _ _, _ ) -> True + (NonLocalDef (UserImport _ _ True) _, _ ) -> True + (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True + other -> False + +isSystemName (Name {n_prov = SystemProv}) = True +isSystemName other = False \end{code} @@ -401,12 +519,7 @@ isLocalName _ = False %************************************************************************ \begin{code} -cmpName n1 n2 = c n1 n2 - where - c (Local u1 _ _) (Local u2 _ _) = compare u1 u2 - c (Local _ _ _) _ = LT - c (Global u1 _ _ _) (Global u2 _ _ _) = compare u1 u2 - c (Global _ _ _ _) _ = GT +cmpName n1 n2 = n_uniq n1 `compare` n_uniq n2 \end{code} \begin{code} @@ -415,20 +528,56 @@ instance Eq Name where a /= b = case (a `compare` b) of { EQ -> False; _ -> True } instance Ord Name where - a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False } - a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False } + a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False } + a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False } a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True } a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True } compare a b = cmpName a b instance Uniquable Name where - uniqueOf = nameUnique + getUnique = nameUnique instance NamedThing Name where getName n = n \end{code} +%************************************************************************ +%* * +\subsection{Name environment} +%* * +%************************************************************************ + +\begin{code} +type NameEnv a = UniqFM a -- Domain is Name + +emptyNameEnv :: NameEnv a +nameEnvElts :: NameEnv a -> [a] +addToNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a +addToNameEnv :: NameEnv a -> Name -> a -> NameEnv a +addListToNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a +plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a +plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a +extendNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a +lookupNameEnv :: NameEnv a -> Name -> Maybe a +delFromNameEnv :: NameEnv a -> Name -> NameEnv a +elemNameEnv :: Name -> NameEnv a -> Bool +unitNameEnv :: Name -> a -> NameEnv a + +emptyNameEnv = emptyUFM +nameEnvElts = eltsUFM +addToNameEnv_C = addToUFM_C +addToNameEnv = addToUFM +addListToNameEnv = addListToUFM +plusNameEnv = plusUFM +plusNameEnv_C = plusUFM_C +extendNameEnv = addListToUFM +lookupNameEnv = lookupUFM +delFromNameEnv = delFromUFM +elemNameEnv = elemUFM +unitNameEnv = unitUFM +\end{code} + %************************************************************************ %* * @@ -441,107 +590,76 @@ instance Outputable Name where -- When printing interfaces, all Locals have been given nice print-names ppr name = pprName name -pprName name +pprName (Name {n_sort = Local, n_uniq = uniq, n_occ = occ, n_prov = prov}) + -- Locals = getPprStyle $ \ sty -> - let - ppr (Local u n _) - | userStyle sty - || ifaceStyle sty = ptext (occNameString n) - | codeStyle sty = pprUnique u - | otherwise = hcat [ptext (occNameString n), ptext SLIT("_"), pprUnique u] - - ppr name@(Global u m n prov) - | codeStyle sty - = identToC (m _APPEND_ SLIT(".") _APPEND_ occNameString n) - - | otherwise - = hcat [pp_mod_dot, ptext (occNameString n), pp_debug sty name] - where - pp_mod_dot - = case prov of -- Omit home module qualifier if its in scope - LocalDef _ _ -> pp_qual dot (user_sty || iface_sty) - NonLocalDef _ hif omit -> pp_qual (pp_hif hif) (omit && user_sty) - WiredInTyCon _ -> pp_qual dot user_sty -- Hack: omit qualifers on wired in things - WiredInId _ -> pp_qual dot user_sty -- in user style only - NoProvenance -> pp_qual dot False - - pp_qual sep omit_qual - | omit_qual = empty - | otherwise = pprModule m <> sep - - dot = text "." - pp_hif HiFile = dot -- Vanilla case - pp_hif HiBootFile = text "!" -- M!t indicates a name imported from a .hi-boot interface - - user_sty = userStyle sty - iface_sty = ifaceStyle sty - in - ppr name - - -pp_debug sty (Global uniq m n prov) - | debugStyle sty = hcat [text "{-", pprUnique uniq, prov_p, text "-}"] - | otherwise = empty - where - prov_p | opt_PprStyle_All = comma <> pp_prov prov - | otherwise = empty - -pp_prov (LocalDef _ Exported) = char 'x' -pp_prov (LocalDef _ NotExported) = char 'l' -pp_prov (NonLocalDef _ _ _) = char 'n' -pp_prov (WiredInTyCon _) = char 'W' -pp_prov (WiredInId _) = char 'w' -pp_prov NoProvenance = char '?' - --- pprNameProvenance is used in error messages to say where a name came from -pprNameProvenance :: Name -> SDoc -pprNameProvenance (Local _ _ loc) = pprProvenance (LocalDef loc NotExported) -pprNameProvenance (Global _ _ _ prov) = pprProvenance prov + if codeStyle sty then + pprUnique uniq -- When printing in code we required all names to + -- be globally unique; for example, we use this identifier + -- for the closure name. So we just print the unique alone. + else + pprOccName occ <> pp_local_extra sty uniq + where + sys_local = case prov of + SystemProv -> True + other -> False -pprProvenance :: Provenance -> SDoc -pprProvenance (LocalDef loc _) = ptext SLIT("Locally defined at") <+> ppr loc -pprProvenance (NonLocalDef loc _ _) = ptext SLIT("Non-locally defined at") <+> ppr loc -pprProvenance (WiredInTyCon tc) = ptext SLIT("Wired-in tycon") -pprProvenance (WiredInId id) = ptext SLIT("Wired-in id") -pprProvenance NoProvenance = ptext SLIT("No provenance") -\end{code} + pp_local_extra sty uniq + | sys_local = underscore <> pprUnique uniq -- Must print uniques for sys_locals + | debugStyle sty = text "{-" <> pprUnique uniq <> text "-}" + | otherwise = empty -%************************************************************************ -%* * -\subsection[Sets of names} -%* * -%************************************************************************ - -\begin{code} -type NameSet = UniqSet Name -emptyNameSet :: NameSet -unitNameSet :: Name -> NameSet -addListToNameSet :: NameSet -> [Name] -> NameSet -addOneToNameSet :: NameSet -> Name -> NameSet -mkNameSet :: [Name] -> NameSet -unionNameSets :: NameSet -> NameSet -> NameSet -unionManyNameSets :: [NameSet] -> NameSet -minusNameSet :: NameSet -> NameSet -> NameSet -elemNameSet :: Name -> NameSet -> Bool -nameSetToList :: NameSet -> [Name] -isEmptyNameSet :: NameSet -> Bool - -isEmptyNameSet = isEmptyUniqSet -emptyNameSet = emptyUniqSet -unitNameSet = unitUniqSet -mkNameSet = mkUniqSet -addListToNameSet = addListToUniqSet -addOneToNameSet = addOneToUniqSet -unionNameSets = unionUniqSets -unionManyNameSets = unionManyUniqSets -minusNameSet = minusUniqSet -elemNameSet = elementOfUniqSet -nameSetToList = uniqSetToList +pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ, n_prov = prov}) + -- Globals, and wired in things + = getPprStyle $ \ sty -> + if codeStyle sty then + ppr mod <> underscore <> ppr occ + else + pp_mod_dot sty <> ppr occ <> pp_global_debug sty uniq prov + where + mod = nameSortModule sort + + pp_mod_dot sty + = case prov of + SystemProv -> pp_qual mod user_sty + -- Hack alert! Omit the qualifier on SystemProv things in user style + -- I claim such SystemProv things will also be WiredIn things. + -- We can't get the omit flag right + -- on wired in tycons etc (sigh) so we just leave it out in user style, + -- and hope that leaving it out isn't too consfusing. + -- (e.g. if the programmer hides Bool and redefines it. If so, use -dppr-debug.) + + LocalDef _ _ -> pp_qual mod (user_sty || iface_sty) + + NonLocalDef (UserImport imp_mod _ _) omit + | user_sty -> pp_qual imp_mod omit + | otherwise -> pp_qual mod False + NonLocalDef ImplicitImport omit -> pp_qual mod (user_sty && omit) + where + user_sty = userStyle sty + iface_sty = ifaceStyle sty + + pp_qual mod omit_qual + | omit_qual = empty + | otherwise = pprModule mod <> dot + + pp_global_debug sty uniq prov + | debugStyle sty = hcat [text "{-", pprUnique uniq, prov_p prov, text "-}"] + | otherwise = empty + + prov_p prov | opt_PprStyle_NoPrags = empty + | otherwise = comma <> pp_prov prov + +pp_prov (LocalDef _ Exported) = char 'x' +pp_prov (LocalDef _ NotExported) = char 'l' +pp_prov (NonLocalDef ImplicitImport _) = char 'j' +pp_prov (NonLocalDef (UserImport _ _ True ) _) = char 'I' -- Imported by name +pp_prov (NonLocalDef (UserImport _ _ False) _) = char 'i' -- Imported by .. +pp_prov SystemProv = char 's' \end{code} - %************************************************************************ %* * \subsection{Overloaded functions related to Names} @@ -550,28 +668,24 @@ nameSetToList = uniqSetToList \begin{code} class NamedThing a where - getOccName :: a -> OccName -- Even RdrNames can do this! + getOccName :: a -> OccName getName :: a -> Name getOccName n = nameOccName (getName n) -- Default method \end{code} \begin{code} -modAndOcc :: NamedThing a => a -> (Module, OccName) getSrcLoc :: NamedThing a => a -> SrcLoc isLocallyDefined :: NamedThing a => a -> Bool -isExported :: NamedThing a => a -> Bool getOccString :: NamedThing a => a -> String +toRdrName :: NamedThing a => a -> RdrName -modAndOcc = nameModAndOcc . getName -isExported = isExportedName . getName getSrcLoc = nameSrcLoc . getName isLocallyDefined = isLocallyDefinedName . getName -getOccString x = _UNPK_ (occNameString (getOccName x)) +getOccString x = occNameString (getOccName x) +toRdrName = ifaceNameRdrName . getName \end{code} \begin{code} -{-# SPECIALIZE isLocallyDefined - :: Name -> Bool - #-} +{-# SPECIALIZE isLocallyDefined :: Name -> Bool #-} \end{code}