-- Like Local, except that we only omit the unique in Iface style
pprSysLocal sty uniq occ
| codeStyle sty = pprUnique uniq
- | ifaceStyle sty = pprOccName occ -- The tidy phase has ensured that OccNames
- -- are enough
+ | ifaceStyle sty = pprOccName occ -- The tidy phase has ensured
+ -- that OccNames are enough
| otherwise = pprOccName occ <> char '_' <> pprUnique uniq
-- If the tidy phase hasn't run, the OccName
-- is unlikely to be informative (like 's'),
mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
- mkGenOcc1, mkGenOcc2,
+ mkGenOcc1, mkGenOcc2, mkLocalOcc,
isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
import Char ( isDigit, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt )
import Util ( thenCmp )
+import Unique ( Unique )
import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
import Outputable
import GlaExts
mk_deriv :: NameSpace
-> String -- Distinguishes one sort of derived name from another
-> EncodedString -- Must be already encoded!! We don't want to encode it a
- -- second time because encoding isn't itempotent
+ -- second time because encoding isn't idempotent
-> OccName
mk_deriv occ_sp sys_prefix str = mkSysOcc occ_sp (encode sys_prefix ++ str)
:: OccName -> OccName
-- These derived variables have a prefix that no Haskell value could have
-mkWorkerOcc = mk_simple_deriv varName "$w"
-mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
-mkDerivedTyConOcc = mk_simple_deriv tcName ":" -- The : prefix makes sure it classifies
-mkClassTyConOcc = mk_simple_deriv tcName ":T" -- as a tycon/datacon
-mkClassDataConOcc = mk_simple_deriv dataName ":D" --
-mkDictOcc = mk_simple_deriv varName "$d"
-mkIPOcc = mk_simple_deriv varName "$i"
-mkSpecOcc = mk_simple_deriv varName "$s"
-mkForeignExportOcc = mk_simple_deriv varName "$f"
+mkWorkerOcc = mk_simple_deriv varName "$w"
+mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
+mkDerivedTyConOcc = mk_simple_deriv tcName ":" -- The : prefix makes sure it classifies
+mkClassTyConOcc = mk_simple_deriv tcName ":T" -- as a tycon/datacon
+mkClassDataConOcc = mk_simple_deriv dataName ":D" --
+mkDictOcc = mk_simple_deriv varName "$d"
+mkIPOcc = mk_simple_deriv varName "$i"
+mkSpecOcc = mk_simple_deriv varName "$s"
+mkForeignExportOcc = mk_simple_deriv varName "$f"
mkGenOcc1 = mk_simple_deriv varName "$gfrom" -- Generics
mkGenOcc2 = mk_simple_deriv varName "$gto" -- Generics
mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
\begin{code}
mkSuperDictSelOcc :: Int -- Index of superclass, eg 3
-> OccName -- Class, eg "Ord"
- -> OccName -- eg "p3Ord"
+ -> OccName -- eg "$p3Ord"
mkSuperDictSelOcc index cls_occ
= mk_deriv varName "$p" (show index ++ occNameString cls_occ)
+
+mkLocalOcc :: Unique -- Unique
+ -> OccName -- Local name (e.g. "sat")
+ -> OccName -- Nice unique version ("$L23sat")
+mkLocalOcc uniq occ
+ = mk_deriv varName "$L" (show uniq ++ occNameString occ)
\end{code}
opt_SccProfilingOn, opt_EnsureSplittableC )
import CostCentre ( CostCentre, CostCentreStack )
import Id ( Id, idName, setIdName )
-import Name ( globaliseName )
+import Name ( nameSrcLoc, nameOccName, nameUnique, isLocalName, mkGlobalName )
+import OccName ( mkLocalOcc )
import Module ( Module )
import PrimRep ( PrimRep(..) )
import TyCon ( TyCon, isDataTyCon )
mkSRT srt_label srt [] `thenC`
setSRTLabel srt_label (
cgTopRhs id' rhs srt_info `thenFC` \ (id, info) ->
- addBindC id info
+ addBindC id info -- Add the un-globalised Id to the envt, so we
+ -- find it when we look up occurrences
)
cgTopBinding (StgRec srt_info pairs, srt)
`thenFC` \ (id, _, _) -> returnFC id
(id':_) -> returnFC id'
--- If we're splitting the object, we need to globalise all the top-level names
--- (and then make sure we only use the globalised one in any C label we use
--- which refers to this name).
-maybeGlobaliseId :: Id -> FCode Id
-maybeGlobaliseId id
- | opt_EnsureSplittableC
- = moduleName `thenFC` \ mod ->
- returnFC (setIdName id (globaliseName (idName id) mod))
- | otherwise -- Globalise the name for -split-objs
- = returnFC id
-
-maybeSplitCode
- | opt_EnsureSplittableC = CSplitMarker
- | otherwise = AbsCNop
-
-- Urgh! I tried moving the forkStatics call from the rhss of cgTopRhs
-- to enclose the listFCs in cgTopBinding, but that tickled the
-- statics "error" call in initC. I DON'T UNDERSTAND WHY!
cgTopRhs :: Id -> StgRhs -> SRT -> FCode (Id, CgIdInfo)
- -- the Id is passed along for setting up a binding...
+ -- The Id is passed along for setting up a binding...
+ -- It's already been globalised if necessary
cgTopRhs bndr (StgRhsCon cc con args) srt
- = maybeGlobaliseId bndr `thenFC` \ bndr' ->
- forkStatics (cgTopRhsCon bndr con args)
+ = forkStatics (cgTopRhsCon bndr con args)
cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag args body) srt
= -- There should be no free variables
let
lf_info = mkClosureLFInfo bndr TopLevel [{-no fvs-}] upd_flag args
in
- maybeGlobaliseId bndr `thenFC` \ bndr' ->
- forkStatics (cgTopRhsClosure bndr' cc bi srt args body lf_info)
+ forkStatics (cgTopRhsClosure bndr cc bi srt args body lf_info)
\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Stuff to support splitting}
+%* *
+%************************************************************************
+
+If we're splitting the object, we need to globalise all the top-level names
+(and then make sure we only use the globalised one in any C label we use
+which refers to this name).
+
+\begin{code}
+maybeGlobaliseId :: Id -> FCode Id
+maybeGlobaliseId id
+ | opt_EnsureSplittableC, -- Globalise the name for -split-objs
+ isLocalName name
+ = moduleName `thenFC` \ mod ->
+ returnFC (setIdName id (mkGlobalName uniq mod new_occ (nameSrcLoc name)))
+ | otherwise
+ = returnFC id
+ where
+ name = idName id
+ uniq = nameUnique name
+ new_occ = mkLocalOcc uniq (nameOccName name)
+ -- We want to conjure up a name that can't clash with any
+ -- existing name. So we generate
+ -- Mod_$L243foo
+ -- where 243 is the unique.
+
+maybeSplitCode
+ | opt_EnsureSplittableC = CSplitMarker
+ | otherwise = AbsCNop
+\end{code}
\ No newline at end of file
import IdInfo {- loads of stuff -}
import NewDemand ( isBottomingSig, topSig )
import BasicTypes ( isNeverActive )
-import Name ( getOccName, nameOccName, globaliseName, setNameOcc,
- localiseName, isGlobalName, setNameUnique
+import Name ( getOccName, nameOccName, mkLocalName, mkGlobalName,
+ localiseName, isGlobalName, nameSrcLoc
)
import NameEnv ( filterNameEnv )
import OccName ( TidyOccEnv, initTidyOccEnv, tidyOccName )
-- so they already have the "right" unique
-- And it's a system-wide unique too
- | local && internal = (ns { nsUniqs = us2 }, occ_env', unique_name)
+ | local && internal = (ns_w_local, occ_env', new_local_name)
-- Even local, internal names must get a unique occurrence, because
-- if we do -split-objs we globalise the name later, in the code generator
--
-- the byte-code generator builds a system-wide Name->BCO symbol table
| local && external = case lookupFM ns_names key of
- Just orig -> (ns, occ_env', orig)
- Nothing -> (ns { nsUniqs = us2, nsNames = ns_names' }, occ_env', global_name)
+ Just orig -> (ns, occ_env', orig)
+ Nothing -> (ns_w_global, occ_env', new_global_name)
-- If we want to globalise a currently-local name, check
-- whether we have already assigned a unique for it.
- -- If so, use it; if not, extend the table.
+ -- If so, use it; if not, extend the table (ns_w_global).
-- This is needed when *re*-compiling a module in GHCi; we want to
-- use the same name for externally-visible things as we did before.
ns_names = nsNames ns
ns_uniqs = nsUniqs ns
(us1, us2) = splitUniqSupply ns_uniqs
- unique_name = setNameUnique (setNameOcc name occ') (uniqFromSupply us1)
- global_name = globaliseName unique_name mod
- ns_names' = addToFM ns_names key global_name
+ uniq = uniqFromSupply us1
+ loc = nameSrcLoc name
+
+ new_local_name = mkLocalName uniq occ' loc
+ new_global_name = mkGlobalName uniq mod occ' loc
+
+ ns_w_local = ns { nsUniqs = us2 }
+ ns_w_global = ns { nsUniqs = us2, nsNames = addToFM ns_names key new_global_name }
------------ Worker --------------
projects / ghc-hetmet.git / commitdiff