X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FName.lhs;h=aac7670cb88e9cafe7a00bdfc5c61e7b79703bc3;hp=c3a1bd1fcdc980a56cce215a1925a193338297c0;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=72462499b891d5779c19f3bda03f96e24f9554ae diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs index c3a1bd1..aac7670 100644 --- a/compiler/basicTypes/Name.lhs +++ b/compiler/basicTypes/Name.lhs @@ -64,17 +64,21 @@ module Name ( getSrcLoc, getSrcSpan, getOccString, pprInfixName, pprPrefixName, pprModulePrefix, + getNameDepth, setNameDepth, -- Re-export the OccName stuff module OccName ) where +#include "Typeable.h" + import {-# SOURCE #-} TypeRep( TyThing ) import OccName import Module import SrcLoc import Unique +import Util import Maybes import Binary import StaticFlags @@ -83,6 +87,7 @@ import FastString import Outputable import Data.Array +import Data.Data import Data.Word ( Word32 ) \end{code} @@ -102,11 +107,18 @@ data Name = Name { --(note later when changing Int# -> FastInt: is that still true about UNPACK?) n_loc :: !SrcSpan -- Definition site } + deriving Typeable -- NOTE: we make the n_loc field strict to eliminate some potential -- (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 @@ -276,7 +288,7 @@ 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 @@ -358,6 +370,12 @@ instance Uniquable Name where instance NamedThing Name where getName n = n + +instance Data Name where + -- don't traverse? + toConstr _ = abstractConstr "Name" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNoRepType "Name" \end{code} %************************************************************************ @@ -439,6 +457,9 @@ 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