[project @ 2000-10-16 11:32:56 by sewardj]

Fix up pprName.  So much simpler than the original that it will
doubtless require fixing later.

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 1410961..a6c5940 100644 (file)
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -19,8 +19,7 @@ module Name (
        nameOccName, nameModule, setNameOcc, nameRdrName, setNameModuleAndLoc, 
        toRdrName, hashName,
 
-       isUserExportedName, isUserImportedName, isUserImportedExplicitlyName, 
-       maybeUserImportedFrom,
+       isUserExportedName,
        nameSrcLoc, isLocallyDefinedName, isDllName,
 
        isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
@@ -49,7 +48,7 @@ import RdrName                ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc,
 import CmdLineOpts     ( opt_Static, opt_PprStyle_NoPrags, 
                          opt_OmitInterfacePragmas, opt_EnsureSplittableC )
 
-import SrcLoc          ( noSrcLoc, SrcLoc )
+import SrcLoc          ( builtinSrcLoc, noSrcLoc, SrcLoc )
 import Unique          ( Unique, Uniquable(..), u2i, pprUnique )
 import Maybes          ( expectJust )
 import FastTypes
@@ -178,8 +177,8 @@ mkImportedLocalName uniq occ loc = mkLocalName uniq occ loc
 
 
 mkGlobalName :: Unique -> Module -> OccName -> SrcLoc -> Name
-mkGlobalName uniq mod occ prov = Name { n_uniq = uniq, n_sort = Global mod,
-                                       n_occ = occ, n_loc = loc }
+mkGlobalName uniq mod occ loc = Name { n_uniq = uniq, n_sort = Global mod,
+                                      n_occ = occ, n_loc = loc }
                                
 
 mkKnownKeyGlobal :: RdrName -> Unique -> Name
@@ -198,8 +197,7 @@ mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = System,
 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 = noSrcLoc }
+                              n_occ = mkCCallOcc str, n_loc = noSrcLoc }
 
 mkTopName :: Unique -> Module -> FAST_STRING -> Name
        -- Make a top-level name; make it Global if top-level
@@ -222,8 +220,7 @@ mkIPName uniq occ
   = Name { n_uniq = uniq,
           n_sort = Local,
           n_occ  = occ,
-          -- ZZ is this an appropriate provinence?
-          n_prov = SystemProv }
+          n_loc = noSrcLoc }
 
 ---------------------------------------------------------------------
 mkDerivedName :: (OccName -> OccName)
@@ -438,78 +435,26 @@ instance Outputable Name where
        -- When printing interfaces, all Locals have been given nice print-names
     ppr name = pprName name
 
-pprName (Name {n_sort = Local, n_uniq = uniq, n_occ = occ, n_prov = prov})
-       -- Locals
+pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
   = getPprStyle $ \ sty ->
-    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
-
-    pp_local_extra sty uniq
-       | sys_local      = underscore <> pprUnique uniq         -- Must print uniques for sys_locals
-       | debugStyle sty = text "{-" <> pprUnique uniq <> text "-}"
-       | otherwise      = empty
-
-
-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
-               -- ToDo (SDM): the following comment is out of date - do
-               -- we need to do anything different now that WiredInNames
-               -- don't exist any more?
-
-               -- 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'
+    let local | debugStyle sty 
+              = pprOccName occ <> text "{-" <> pprUnique uniq <> text "-}"
+              | codeStyle sty
+              = pprUnique uniq
+              | otherwise
+              = pprOccName occ
+
+        global m | codeStyle sty
+                 = ppr (moduleName m) <> char '_' <> pprOccName occ
+                 | debugStyle sty || not (isLocalModule m)
+                 = ppr (moduleName m) <> dot <> pprOccName occ
+                 | otherwise
+                 = pprOccName occ
+     in case sort of
+           System     -> local
+           Local      -> local
+           Exported   -> local
+           Global mod -> global mod
 \end{code}