From: sewardj Date: Mon, 16 Oct 2000 11:32:56 +0000 (+0000) Subject: [project @ 2000-10-16 11:32:56 by sewardj] X-Git-Tag: Approximately_9120_patches~3580 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=108a91467099c1dda7fc0e69c6dd7a1928137fe2;p=ghc-hetmet.git [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 --- 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}