X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FName.lhs;h=de8a3a32b55602916f07908cba5e061d9b8632a6;hp=6fccb7f6caa5b6b65221b7f1b396cfd57d7e1beb;hb=34c8d0312071f7d0f4d221a997d3408c653ef9e5;hpb=ad94d40948668032189ad22a0ad741ac1f645f50 diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs index 6fccb7f..de8a3a3 100644 --- a/compiler/basicTypes/Name.lhs +++ b/compiler/basicTypes/Name.lhs @@ -5,61 +5,90 @@ \section[Name]{@Name@: to transmit name info from renamer to typechecker} \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings --- for details +-- | +-- #name_types# +-- GHC uses several kinds of name internally: +-- +-- * 'OccName.OccName': see "OccName#name_types" +-- +-- * 'RdrName.RdrName': see "RdrName#name_types" +-- +-- * 'Name.Name' is the type of names that have had their scoping and binding resolved. They +-- have an 'OccName.OccName' but also a 'Unique.Unique' that disambiguates Names that have +-- the same 'OccName.OccName' and indeed is used for all 'Name.Name' comparison. Names +-- also contain information about where they originated from, see "Name#name_sorts" +-- +-- * 'Id.Id': see "Id#name_types" +-- +-- * 'Var.Var': see "Var#name_types" +-- +-- #name_sorts# +-- Names are one of: +-- +-- * External, if they name things declared in other modules. Some external +-- Names are wired in, i.e. they name primitives defined in the compiler itself +-- +-- * Internal, if they name things in the module being compiled. Some internal +-- Names are system names, if they are names manufactured by the compiler module Name ( - -- Re-export the OccName stuff - module OccName, - - -- The Name type + -- * The main types Name, -- Abstract - BuiltInSyntax(..), - mkInternalName, mkSystemName, + BuiltInSyntax(..), + + -- ** Creating 'Name's + mkInternalName, mkSystemName, mkDerivedInternalName, mkSystemVarName, mkSysTvName, mkFCallName, mkIPName, mkTickBoxOpName, mkExternalName, mkWiredInName, + -- ** Manipulating and deconstructing 'Name's nameUnique, setNameUnique, nameOccName, nameModule, nameModule_maybe, tidyNameOcc, hashName, localiseName, - nameSrcLoc, nameSrcSpan, + nameSrcLoc, nameSrcSpan, pprNameLoc, + -- ** Predicates on 'Name's isSystemName, isInternalName, isExternalName, - isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax, + isTyVarName, isTyConName, isDataConName, + isValName, isVarName, + isWiredInName, isBuiltInSyntax, wiredInNameTyThing_maybe, nameIsLocalOrFrom, - - -- Class NamedThing and overloaded friends + + -- * Class 'NamedThing' and overloaded friends NamedThing(..), - getSrcLoc, getSrcSpan, getOccString + getSrcLoc, getSrcSpan, getOccString, + + pprInfixName, pprPrefixName, pprModulePrefix, + getNameDepth, setNameDepth, + + -- Re-export the OccName stuff + module OccName ) where -#include "HsVersions.h" +#include "Typeable.h" import {-# SOURCE #-} TypeRep( TyThing ) import OccName import Module import SrcLoc -import UniqFM import Unique +import Util import Maybes import Binary -import FastMutInt +import StaticFlags +import FastTypes import FastString import Outputable -import Data.IORef -import GHC.Exts import Data.Array +import Data.Data +import Data.Word ( Word32 ) \end{code} %************************************************************************ @@ -69,10 +98,13 @@ import Data.Array %************************************************************************ \begin{code} +-- | A unique, unambigious name for something, containing information about where +-- that thing originated. data Name = Name { n_sort :: NameSort, -- What sort of name it is n_occ :: !OccName, -- Its occurrence name - n_uniq :: Int#, -- UNPACK doesn't work, recursive type + n_uniq :: FastInt, -- UNPACK doesn't work, recursive type +--(note later when changing Int# -> FastInt: is that still true about UNPACK?) n_loc :: !SrcSpan -- Definition site } @@ -80,6 +112,12 @@ data Name = Name { -- (and real!) space leaks, due to the fact that we don't look at -- the SrcLoc in a Name all that often. +setNameDepth :: Int -> Name -> Name +setNameDepth depth name = name { n_occ = setOccNameDepth depth (n_occ name) } + +getNameDepth :: Name -> Int +getNameDepth name = getOccNameDepth $ n_occ name + data NameSort = External Module @@ -92,10 +130,10 @@ data NameSort | System -- A system-defined Id or TyVar. Typically the -- OccName is very uninformative (like 's') -data BuiltInSyntax = BuiltInSyntax | UserSyntax --- BuiltInSyntax is for things like (:), [], tuples etc, --- which have special syntactic forms. They aren't "in scope" +-- | BuiltInSyntax is for things like @(:)@, @[]@ and tuples, +-- which have special syntactic forms. They aren't in scope -- as such. +data BuiltInSyntax = BuiltInSyntax | UserSyntax \end{code} Notes about the NameSorts: @@ -136,12 +174,18 @@ nameModule :: Name -> Module nameSrcLoc :: Name -> SrcLoc nameSrcSpan :: Name -> SrcSpan -nameUnique name = mkUniqueGrimily (I# (n_uniq name)) +nameUnique name = mkUniqueGrimily (iBox (n_uniq name)) nameOccName name = n_occ name nameSrcLoc name = srcSpanStart (n_loc name) nameSrcSpan name = n_loc name \end{code} +%************************************************************************ +%* * +\subsection{Predicates on names} +%* * +%************************************************************************ + \begin{code} nameIsLocalOrFrom :: Module -> Name -> Bool isInternalName :: Name -> Bool @@ -150,25 +194,27 @@ isSystemName :: Name -> Bool isWiredInName :: Name -> Bool isWiredInName (Name {n_sort = WiredIn _ _ _}) = True -isWiredInName other = False +isWiredInName _ = False wiredInNameTyThing_maybe :: Name -> Maybe TyThing wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing -wiredInNameTyThing_maybe other = Nothing +wiredInNameTyThing_maybe _ = Nothing +isBuiltInSyntax :: Name -> Bool isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True -isBuiltInSyntax other = False +isBuiltInSyntax _ = False isExternalName (Name {n_sort = External _}) = True isExternalName (Name {n_sort = WiredIn _ _ _}) = True -isExternalName other = False +isExternalName _ = False isInternalName name = not (isExternalName name) nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name) +nameModule_maybe :: Name -> Maybe Module nameModule_maybe (Name { n_sort = External mod}) = Just mod nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod -nameModule_maybe name = Nothing +nameModule_maybe _ = Nothing nameIsLocalOrFrom from name | isExternalName name = from == nameModule name @@ -180,8 +226,17 @@ isTyVarName name = isTvOcc (nameOccName name) isTyConName :: Name -> Bool isTyConName name = isTcOcc (nameOccName name) +isDataConName :: Name -> Bool +isDataConName name = isDataOcc (nameOccName name) + +isValName :: Name -> Bool +isValName name = isValOcc (nameOccName name) + +isVarName :: Name -> Bool +isVarName = isVarOcc . nameOccName + isSystemName (Name {n_sort = System}) = True -isSystemName other = False +isSystemName _ = False \end{code} @@ -192,8 +247,10 @@ isSystemName other = False %************************************************************************ \begin{code} +-- | Create a name which is (for now at least) local to the current module and hence +-- does not need a 'Module' to disambiguate it from other 'Name's mkInternalName :: Unique -> OccName -> SrcSpan -> Name -mkInternalName uniq occ loc = Name { n_uniq = getKey# uniq, n_sort = Internal, n_occ = occ, n_loc = loc } +mkInternalName uniq occ loc = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, n_occ = occ, n_loc = loc } -- 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 @@ -203,41 +260,51 @@ mkInternalName uniq occ loc = Name { n_uniq = getKey# uniq, n_sort = Internal, n -- * for interface files we tidyCore first, which puts the uniques -- into the print name (see setNameVisibility below) +mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name +mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc }) + = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal + , n_occ = derive_occ occ, n_loc = loc } + +-- | Create a name which definitely originates in the given module mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name mkExternalName uniq mod occ loc - = Name { n_uniq = getKey# uniq, n_sort = External mod, + = Name { n_uniq = getKeyFastInt uniq, n_sort = External mod, n_occ = occ, n_loc = loc } -mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax - -> Name +-- | Create a name which is actually defined by the compiler itself +mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name mkWiredInName mod occ uniq thing built_in - = Name { n_uniq = getKey# uniq, + = Name { n_uniq = getKeyFastInt uniq, n_sort = WiredIn mod thing built_in, n_occ = occ, n_loc = wiredInSrcSpan } +-- | Create a name brought into being by the compiler mkSystemName :: Unique -> OccName -> Name -mkSystemName uniq occ = Name { n_uniq = getKey# uniq, n_sort = System, +mkSystemName uniq occ = Name { n_uniq = getKeyFastInt uniq, n_sort = System, n_occ = occ, n_loc = noSrcSpan } mkSystemVarName :: Unique -> FastString -> Name mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs) mkSysTvName :: Unique -> FastString -> Name -mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) +mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) +-- | Make a name for a foreign call mkFCallName :: Unique -> String -> Name -- The encoded string completely describes the ccall -mkFCallName uniq str = Name { n_uniq = getKey# uniq, n_sort = Internal, +mkFCallName uniq str = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, n_occ = mkVarOcc str, n_loc = noSrcSpan } + mkTickBoxOpName :: Unique -> String -> Name mkTickBoxOpName uniq str - = Name { n_uniq = getKey# uniq, n_sort = Internal, + = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, n_occ = mkVarOcc str, n_loc = noSrcSpan } +-- | Make the name of an implicit parameter mkIPName :: Unique -> OccName -> Name mkIPName uniq occ - = Name { n_uniq = getKey# uniq, + = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, n_occ = occ, n_loc = noSrcSpan } @@ -248,7 +315,7 @@ mkIPName uniq occ -- 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. setNameUnique :: Name -> Unique -> Name -setNameUnique name uniq = name {n_uniq = getKey# uniq} +setNameUnique name uniq = name {n_uniq = getKeyFastInt uniq} tidyNameOcc :: Name -> OccName -> Name -- We set the OccName of a Name when tidying @@ -257,14 +324,14 @@ tidyNameOcc :: Name -> OccName -> Name tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal} tidyNameOcc name occ = name { n_occ = occ } +-- | Make the 'Name' into an internal name, regardless of what it was to begin with localiseName :: Name -> Name localiseName n = n { n_sort = Internal } \end{code} - %************************************************************************ %* * -\subsection{Predicates and selectors} +\subsection{Hashing and comparison} %* * %************************************************************************ @@ -274,8 +341,10 @@ hashName name = getKey (nameUnique name) + 1 -- The +1 avoids keys with lots of zeros in the ls bits, which -- interacts badly with the cheap and cheerful multiplication in -- hashExpr -\end{code} +cmpName :: Name -> Name -> Ordering +cmpName n1 n2 = iBox (n_uniq n1) `compare` iBox (n_uniq n2) +\end{code} %************************************************************************ %* * @@ -284,10 +353,6 @@ hashName name = getKey (nameUnique name) + 1 %************************************************************************ \begin{code} -cmpName n1 n2 = I# (n_uniq n1) `compare` I# (n_uniq n2) -\end{code} - -\begin{code} instance Eq Name where a == b = case (a `compare` b) of { EQ -> True; _ -> False } a /= b = case (a `compare` b) of { EQ -> False; _ -> True } @@ -304,6 +369,14 @@ instance Uniquable Name where instance NamedThing Name where getName n = n + +INSTANCE_TYPEABLE0(Name,nameTc,"Name") + +instance Data Name where + -- don't traverse? + toConstr _ = abstractConstr "Name" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNoRepType "Name" \end{code} %************************************************************************ @@ -314,24 +387,13 @@ instance NamedThing Name where \begin{code} instance Binary Name where - put_ bh name = do - case getUserData bh of { - UserData { ud_symtab_map = symtab_map_ref, - ud_symtab_next = symtab_next } -> do - symtab_map <- readIORef symtab_map_ref - case lookupUFM symtab_map name of - Just (off,_) -> put_ bh off - Nothing -> do - off <- readFastMutInt symtab_next - writeFastMutInt symtab_next (off+1) - writeIORef symtab_map_ref - $! addToUFM symtab_map name (off,name) - put_ bh off - } + put_ bh name = + case getUserData bh of + UserData{ ud_put_name = put_name } -> put_name bh name get bh = do i <- get bh - return $! (ud_symtab (getUserData bh) ! i) + return $! (ud_symtab (getUserData bh) ! fromIntegral (i::Word32)) \end{code} %************************************************************************ @@ -347,56 +409,91 @@ instance Outputable Name where instance OutputableBndr Name where pprBndr _ name = pprName name -pprName name@(Name {n_sort = sort, n_uniq = u#, n_occ = occ}) +pprName :: Name -> SDoc +pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ}) = getPprStyle $ \ sty -> case sort of WiredIn mod _ builtin -> pprExternal sty uniq mod occ True builtin External mod -> pprExternal sty uniq mod occ False UserSyntax System -> pprSystem sty uniq occ Internal -> pprInternal sty uniq occ - where uniq = mkUniqueGrimily (I# u#) + where uniq = mkUniqueGrimily (iBox u) +pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc pprExternal sty uniq mod occ is_wired is_builtin - | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ + | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ -- In code style, always qualify -- ToDo: maybe we could print all wired-in things unqualified -- in code style, to reduce symbol table bloat? - | debugStyle sty = ppr mod <> dot <> ppr_occ_name occ - <> braces (hsep [if is_wired then ptext SLIT("(w)") else empty, - pprNameSpaceBrief (occNameSpace occ), - pprUnique uniq]) - | BuiltInSyntax <- is_builtin = ppr_occ_name occ - -- never qualify builtin syntax - | Just mod <- qualName sty mod occ = ppr mod <> dot <> ppr_occ_name occ - -- the PrintUnqualified tells us how to qualify this Name, if at all - | otherwise = ppr_occ_name occ - + | debugStyle sty = ppr mod <> dot <> ppr_occ_name occ + <> braces (hsep [if is_wired then ptext (sLit "(w)") else empty, + pprNameSpaceBrief (occNameSpace occ), + pprUnique uniq]) + | BuiltInSyntax <- is_builtin = ppr_occ_name occ -- Never qualify builtin syntax + | otherwise = pprModulePrefix sty mod occ <> ppr_occ_name occ + +pprInternal :: PprStyle -> Unique -> OccName -> SDoc pprInternal sty uniq occ | codeStyle sty = pprUnique uniq | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ), pprUnique uniq]) - | dumpStyle sty = ppr_occ_name occ <> char '_' <> pprUnique uniq + | dumpStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq -- For debug dumps, we're not necessarily dumping -- tidied code, so we need to print the uniques. | otherwise = ppr_occ_name occ -- User style -- Like Internal, except that we only omit the unique in Iface style +pprSystem :: PprStyle -> Unique -> OccName -> SDoc pprSystem sty uniq occ | codeStyle sty = pprUnique uniq - | debugStyle sty = ppr_occ_name occ <> char '_' <> pprUnique uniq + | debugStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq <> braces (pprNameSpaceBrief (occNameSpace occ)) - | otherwise = ppr_occ_name occ <> char '_' <> pprUnique uniq + | otherwise = ppr_occ_name occ <> ppr_underscore_unique uniq -- If the tidy phase hasn't run, the OccName -- is unlikely to be informative (like 's'), -- so print the unique + +pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc +-- Print the "M." part of a name, based on whether it's in scope or not +-- See Note [Printing original names] in HscTypes +pprModulePrefix sty mod occ + | opt_SuppressModulePrefixes = empty + + | otherwise + = case qualName sty mod occ of -- See Outputable.QualifyName: + NameQual modname -> ppr modname <> dot -- Name is in scope + NameNotInScope1 -> ppr mod <> dot -- Not in scope + NameNotInScope2 -> ppr (modulePackageId mod) <> colon -- Module not in + <> ppr (moduleName mod) <> dot -- scope eithber + _otherwise -> empty + +ppr_underscore_unique :: Unique -> SDoc +-- Print an underscore separating the name from its unique +-- But suppress it if we aren't printing the uniques anyway +ppr_underscore_unique uniq + | opt_SuppressUniques = empty + | otherwise = char '_' <> pprUnique uniq + +ppr_occ_name :: OccName -> SDoc ppr_occ_name occ = ftext (occNameFS occ) -- Don't use pprOccName; instead, just print the string of the OccName; -- we print the namespace in the debug stuff above -- In code style, we Z-encode the strings. The results of Z-encoding each FastString are -- cached behind the scenes in the FastString implementation. +ppr_z_occ_name :: OccName -> SDoc ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ)) + +-- Prints (if mod information is available) "Defined at " or +-- "Defined in " information for a Name. +pprNameLoc :: Name -> SDoc +pprNameLoc name + | isGoodSrcSpan loc = pprDefnLoc loc + | isInternalName name || isSystemName name + = ptext (sLit "") + | otherwise = ptext (sLit "Defined in ") <> ppr (nameModule name) + where loc = nameSrcSpan name \end{code} %************************************************************************ @@ -406,6 +503,7 @@ ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ)) %************************************************************************ \begin{code} +-- | A class allowing convenient access to the 'Name' of various datatypes class NamedThing a where getOccName :: a -> OccName getName :: a -> Name @@ -421,5 +519,11 @@ getOccString :: NamedThing a => a -> String getSrcLoc = nameSrcLoc . getName getSrcSpan = nameSrcSpan . getName getOccString = occNameString . getOccName + +pprInfixName, pprPrefixName :: (Outputable a, NamedThing a) => a -> SDoc +-- See Outputable.pprPrefixVar, pprInfixVar; +-- add parens or back-quotes as appropriate +pprInfixName n = pprInfixVar (isSymOcc (getOccName n)) (ppr n) +pprPrefixName n = pprPrefixVar (isSymOcc (getOccName n)) (ppr n) \end{code}