[project @ 2005-02-25 13:06:31 by simonpj]
[ghc-hetmet.git] / ghc / compiler / basicTypes / Name.lhs
index 234180e..4ea51b6 100644 (file)
@@ -11,22 +11,22 @@ module Name (
        -- The Name type
        Name,                                   -- Abstract
        BuiltInSyntax(..), 
-       mkInternalName, mkSystemName, 
-       mkSystemNameEncoded, mkSysTvName, 
+       mkInternalName, mkSystemName,
+       mkSystemVarName, mkSystemVarNameEncoded, mkSysTvName, 
        mkFCallName, mkIPName,
        mkExternalName, mkWiredInName,
 
        nameUnique, setNameUnique,
-       nameOccName, nameModule, nameModule_maybe, nameModuleName,
+       nameOccName, nameModule, nameModule_maybe,
        setNameOcc, 
        hashName, localiseName,
 
        nameSrcLoc, nameParent, nameParent_maybe,
 
        isSystemName, isInternalName, isExternalName,
-       isTyVarName, isDllName, isWiredInName, isBuiltInSyntax,
+       isTyVarName, isWiredInName, isBuiltInSyntax,
        wiredInNameTyThing_maybe, 
-       nameIsLocalOrFrom, isHomePackageName,
+       nameIsLocalOrFrom,
        
        -- Class NamedThing and overloaded friends
        NamedThing(..),
@@ -38,12 +38,10 @@ module Name (
 import {-# SOURCE #-} TypeRep( TyThing )
 
 import OccName         -- All of it
-import Module          ( Module, ModuleName, moduleName, isHomeModule )
-import CmdLineOpts     ( opt_Static )
+import Module          ( Module )
 import SrcLoc          ( noSrcLoc, wiredInSrcLoc, SrcLoc )
 import Unique          ( Unique, Uniquable(..), getKey, pprUnique )
 import Maybes          ( orElse )
-import FastTypes
 import Outputable
 \end{code}
 
@@ -121,7 +119,6 @@ All built-in syntax is for wired-in things.
 nameUnique             :: Name -> Unique
 nameOccName            :: Name -> OccName 
 nameModule             :: Name -> Module
-nameModuleName         :: Name -> ModuleName
 nameSrcLoc             :: Name -> SrcLoc
 
 nameUnique  name = n_uniq name
@@ -134,7 +131,6 @@ nameIsLocalOrFrom :: Module -> Name -> Bool
 isInternalName   :: Name -> Bool
 isExternalName   :: Name -> Bool
 isSystemName     :: Name -> Bool
-isHomePackageName :: Name -> Bool
 isWiredInName    :: Name -> Bool
 
 isWiredInName (Name {n_sort = WiredIn _ _ _ _}) = True
@@ -164,8 +160,6 @@ nameParent name = case nameParent_maybe name of
                        Nothing     -> name
 
 nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
-nameModuleName name = moduleName (nameModule name)
-
 nameModule_maybe (Name { n_sort = External mod _})    = Just mod
 nameModule_maybe (Name { n_sort = WiredIn mod _ _ _}) = Just mod
 nameModule_maybe name                                = Nothing
@@ -174,13 +168,6 @@ nameIsLocalOrFrom from name
   | isExternalName name = from == nameModule name
   | otherwise          = True
 
-isHomePackageName name
-  | isExternalName name = isHomeModule (nameModule name)
-  | otherwise          = True          -- Internal 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)
 
@@ -219,21 +206,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
@@ -312,7 +298,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
@@ -321,43 +306,44 @@ instance OutputableBndr Name where
 pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
   = getPprStyle $ \ sty ->
     case sort of
-      WiredIn mod _ _ BuiltInSyntax -> pprOccName occ  -- Built-in syntax is never qualified
-      WiredIn mod _ _ UserSyntax    -> pprExternal sty uniq mod occ True
-      External mod _               -> pprExternal sty uniq mod occ False
-      System                               -> pprSystem sty uniq occ
-      Internal                     -> pprInternal sty uniq occ
-
-pprExternal sty uniq mod occ is_wired
-  | codeStyle sty        = ppr mod_name <> char '_' <> pprOccName occ
+      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
+
+pprExternal sty uniq mod occ is_wired is_builtin
+  | codeStyle sty        = ppr mod <> char '_' <> ppr_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?
-  | unqualStyle sty mod_name occ = pprOccName occ
-       -- Never qualify built-in syntax otherwise
-  | debugStyle sty       = sep [ppr mod_name <> dot <> pprOccName occ,
-                               hsep [text "{-" 
-                                    , if is_wired then ptext SLIT("(w)") else empty
-                                    , pprUnique uniq
--- (overkill)                       , case mb_p of
---                                      Nothing -> empty
---                                      Just n  -> brackets (ppr n)
-                                    , text "-}"]]
-  | otherwise                   = ppr mod_name <> dot <> pprOccName occ
-  where
-    mod_name = moduleName mod
+  | debugStyle sty       = ppr mod <> dot <> ppr_occ_name occ
+                          <> braces (hsep [if is_wired then ptext SLIT("(w)") else empty,
+                                           text (briefOccNameFlavour occ), 
+                                           pprUnique uniq])
+  | BuiltInSyntax <- is_builtin  = ppr_occ_name occ
+       -- never qualify builtin syntax
+  | unqualStyle sty mod occ = ppr_occ_name occ
+  | otherwise              = ppr mod <> dot <> ppr_occ_name occ
 
 pprInternal sty uniq occ
   | codeStyle sty  = pprUnique uniq
-  | debugStyle sty = pprOccName occ <> text "{-" <> pprUnique uniq <> text "-}"
-  | otherwise      = pprOccName occ    -- User style
+  | debugStyle sty = ppr_occ_name occ <> braces (hsep [text (briefOccNameFlavour occ), 
+                                                      pprUnique uniq])
+  | otherwise      = ppr_occ_name occ  -- User style
 
 -- Like Internal, except that we only omit the unique in Iface style
 pprSystem sty uniq occ
   | codeStyle sty  = pprUnique uniq
-  | otherwise     = pprOccName occ <> char '_' <> pprUnique uniq
+  | debugStyle sty = ppr_occ_name occ <> char '_' <> pprUnique uniq
+                    <> braces (text (briefOccNameFlavour occ))
+  | otherwise     = ppr_occ_name occ <> char '_' <> pprUnique uniq
                                -- If the tidy phase hasn't run, the OccName
                                -- is unlikely to be informative (like 's'),
                                -- so print the unique
+
+ppr_occ_name occ = pprEncodedFS (occNameFS occ)
+       -- Don't use pprOccName; instead, just print the string of the OccName; 
+       -- we print the namespace in the debug stuff above
 \end{code}
 
 %************************************************************************