X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FName.lhs;h=1e1fb31f846afd7ed2bbf709d9ecc7192ed99d17;hb=ac10f8408520a30e8437496d320b8b86afda2e8f;hp=f0ef363fa59e16eae63d1c4e562df19b1e089d81;hpb=ef5b4b146aa172d8ac10f39b5eb3d7a0f948d8f1;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index f0ef363..1e1fb31 100644 --- a/ghc/compiler/basicTypes/Name.lhs +++ b/ghc/compiler/basicTypes/Name.lhs @@ -11,17 +11,17 @@ module Name ( -- The Name type Name, -- Abstract BuiltInSyntax(..), - mkInternalName, mkSystemName, - mkSystemNameEncoded, mkSysTvName, + mkInternalName, mkSystemName, + mkSystemVarName, mkSysTvName, mkFCallName, mkIPName, mkExternalName, mkWiredInName, nameUnique, setNameUnique, nameOccName, nameModule, nameModule_maybe, - setNameOcc, + tidyNameOcc, hashName, localiseName, - nameSrcLoc, nameParent, nameParent_maybe, + nameSrcLoc, nameParent, nameParent_maybe, isImplicitName, isSystemName, isInternalName, isExternalName, isTyVarName, isWiredInName, isBuiltInSyntax, @@ -38,10 +38,11 @@ module Name ( import {-# SOURCE #-} TypeRep( TyThing ) import OccName -- All of it -import Module ( Module ) +import Module ( Module, moduleFS ) import SrcLoc ( noSrcLoc, wiredInSrcLoc, SrcLoc ) import Unique ( Unique, Uniquable(..), getKey, pprUnique ) -import Maybes ( orElse ) +import Maybes ( orElse, isJust ) +import FastString ( FastString, zEncodeFS ) import Outputable \end{code} @@ -159,6 +160,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,26 +212,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 } --- 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 } +mkSystemVarName :: Unique -> FastString -> Name +mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs) -mkSysTvName :: Unique -> EncodedFS -> Name -mkSysTvName uniq fs = Name { n_uniq = uniq, n_sort = System, - n_occ = mkSysOccFS tvName fs, - n_loc = noSrcLoc } +mkSysTvName :: Unique -> FastString -> Name +mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) -mkFCallName :: Unique -> EncodedString -> Name +mkFCallName :: Unique -> String -> Name -- The encoded string completely describes the ccall mkFCallName uniq str = Name { n_uniq = uniq, n_sort = Internal, - n_occ = mkFCallOcc str, n_loc = noSrcLoc } + n_occ = mkVarOcc str, n_loc = noSrcLoc } mkIPName :: Unique -> OccName -> Name mkIPName uniq occ @@ -241,8 +241,12 @@ mkIPName uniq occ -- one in the thing it's the name of. If you know what I mean. setNameUnique name uniq = name {n_uniq = uniq} -setNameOcc :: Name -> OccName -> Name -setNameOcc name occ = name {n_occ = occ} +tidyNameOcc :: Name -> OccName -> Name +-- We set the OccName of a Name when tidying +-- In doing so, we change System --> Internal, so that when we print +-- it we don't get the unique by default. It's tidy now! +tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal} +tidyNameOcc name occ = name { n_occ = occ } localiseName :: Name -> Name localiseName n = n { n_sort = Internal } @@ -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 @@ -314,13 +317,13 @@ pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ}) Internal -> pprInternal sty uniq occ pprExternal sty uniq mod occ is_wired is_builtin - | codeStyle sty = ppr mod <> char '_' <> ppr_occ_name occ + | codeStyle sty = ppr_z_module mod <> char '_' <> ppr_z_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? | debugStyle sty = ppr mod <> dot <> ppr_occ_name occ <> braces (hsep [if is_wired then ptext SLIT("(w)") else empty, - text (briefOccNameFlavour occ), + pprNameSpaceBrief (occNameSpace occ), pprUnique uniq]) | BuiltInSyntax <- is_builtin = ppr_occ_name occ -- never qualify builtin syntax @@ -329,23 +332,32 @@ pprExternal sty uniq mod occ is_wired is_builtin pprInternal sty uniq occ | codeStyle sty = pprUnique uniq - | debugStyle sty = ppr_occ_name occ <> braces (hsep [text (briefOccNameFlavour occ), + | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace 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 pprSystem sty uniq occ | codeStyle sty = pprUnique uniq | debugStyle sty = ppr_occ_name occ <> char '_' <> pprUnique uniq - <> braces (text (briefOccNameFlavour occ)) + <> braces (pprNameSpaceBrief (occNameSpace 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) +ppr_occ_name occ = ftext (occNameFS occ) -- Don't use pprOccName; instead, just print the string of the OccName; -- we print the namespace in the debug stuff above + +-- In code style, we Z-encode the strings. The results of Z-encoding each FastString are +-- cached behind the scenes in the FastString implementation. +ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ)) +ppr_z_module mod = ftext (zEncodeFS (moduleFS mod)) + \end{code} %************************************************************************