[project @ 2005-07-25 11:10:01 by simonpj]

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

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index f0ef363..fd8f2cf 100644 (file)
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -11,8 +11,8 @@ module Name (
        -- The Name type
        Name,                                   -- Abstract
        BuiltInSyntax(..), 
-       mkInternalName, mkSystemName, 
-       mkSystemNameEncoded, mkSysTvName, 
+       mkInternalName, mkSystemName,
+       mkSystemVarName, mkSystemVarNameEncoded, mkSysTvName, 
        mkFCallName, mkIPName,
        mkExternalName, mkWiredInName,
 
@@ -21,7 +21,7 @@ module Name (
        setNameOcc, 
        hashName, localiseName,
 
-       nameSrcLoc, nameParent, nameParent_maybe,
+       nameSrcLoc, nameParent, nameParent_maybe, isImplicitName, 
 
        isSystemName, isInternalName, isExternalName,
        isTyVarName, isWiredInName, isBuiltInSyntax,
@@ -41,7 +41,7 @@ import OccName                -- All of it
 import Module          ( Module )
 import SrcLoc          ( noSrcLoc, wiredInSrcLoc, SrcLoc )
 import Unique          ( Unique, Uniquable(..), getKey, pprUnique )
-import Maybes          ( orElse )
+import Maybes          ( orElse, isJust )
 import Outputable
 \end{code}
 
@@ -159,6 +159,11 @@ nameParent name = case nameParent_maybe name of
                        Just parent -> parent
                        Nothing     -> name
 
+isImplicitName :: Name -> Bool
+-- An Implicit Name is one has a parent; that is, one whose definition
+-- derives from the parent thing
+isImplicitName name = isJust (nameParent_maybe name)
+
 nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
 nameModule_maybe (Name { n_sort = External mod _})    = Just mod
 nameModule_maybe (Name { n_sort = WiredIn mod _ _ _}) = Just mod
@@ -206,21 +211,20 @@ mkWiredInName mod occ uniq mb_parent thing built_in
           n_sort = WiredIn mod mb_parent thing built_in,
           n_occ = occ, n_loc = wiredInSrcLoc }
 
-mkSystemName :: Unique -> UserFS -> Name
-mkSystemName uniq fs = Name { n_uniq = uniq, n_sort = System, 
-                             n_occ = mkVarOcc fs, n_loc = noSrcLoc }
+mkSystemName :: Unique -> OccName -> Name
+mkSystemName uniq occ = Name { n_uniq = uniq, n_sort = System, 
+                              n_occ = occ, n_loc = noSrcLoc }
+
+mkSystemVarName :: Unique -> UserFS -> Name
+mkSystemVarName uniq fs = mkSystemName uniq (mkVarOcc fs)
 
 -- Use this version when the string is already encoded.  Avoids duplicating
 -- the string each time a new name is created.
-mkSystemNameEncoded :: Unique -> EncodedFS -> Name
-mkSystemNameEncoded uniq fs = Name { n_uniq = uniq, n_sort = System, 
-                                    n_occ = mkSysOccFS varName fs, 
-                                    n_loc = noSrcLoc }
+mkSystemVarNameEncoded :: Unique -> EncodedFS -> Name
+mkSystemVarNameEncoded uniq fs = mkSystemName uniq (mkSysOccFS varName fs) 
 
 mkSysTvName :: Unique -> EncodedFS -> Name
-mkSysTvName uniq fs = Name { n_uniq = uniq, n_sort = System, 
-                            n_occ = mkSysOccFS tvName fs, 
-                            n_loc = noSrcLoc }
+mkSysTvName uniq fs = mkSystemName uniq (mkSysOccFS tvName fs) 
 
 mkFCallName :: Unique -> EncodedString -> Name
        -- The encoded string completely describes the ccall
@@ -299,7 +303,6 @@ instance NamedThing Name where
 
 \begin{code}
 instance Outputable Name where
-       -- When printing interfaces, all Internals have been given nice print-names
     ppr name = pprName name
 
 instance OutputableBndr Name where
@@ -331,6 +334,9 @@ pprInternal sty uniq occ
   | codeStyle sty  = pprUnique uniq
   | debugStyle sty = ppr_occ_name occ <> braces (hsep [text (briefOccNameFlavour occ), 
                                                       pprUnique uniq])
+  | dumpStyle sty  = ppr_occ_name occ <> char '_' <> pprUnique 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