Commit fda89b29 authored by sof's avatar sof

[project @ 1997-07-05 03:02:04 by sof]

Changes through ID4
parent 5f34bb74
......@@ -68,7 +68,6 @@ import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
import CStrings ( pp_cSEP )
import Id ( externallyVisibleId, cmpId_withSpecDataCon,
isDataCon, isDictFunId,
isConstMethodId_maybe,
isDefaultMethodId_maybe,
isSuperDictSelId_maybe, fIRST_TAG,
SYN_IE(ConTag), GenId{-instance Outputable-},
......@@ -329,7 +328,7 @@ pprCLabel_asm = pprCLabel (PprForAsm underscorePrefix fmtAsmLbl)
pprCLabel :: PprStyle -> CLabel -> Doc
pprCLabel (PprForAsm _ fmtAsmLbl) (AsmTempLabel u)
= text (fmtAsmLbl (_UNPK_ (showUnique u)))
= text (fmtAsmLbl (showUnique u))
pprCLabel (PprForAsm prepend_cSEP _) lbl
= if prepend_cSEP
......
......@@ -319,7 +319,7 @@ pprHeapOffsetPieces sty int_offs fxdhdr_offs varhdr_offs tothdr_offs
case (catMaybes [pp_tothdr_offs, pp_varhdr_offs, pp_fxdhdr_offs, pp_int_offs]) of
[] -> char '0'
[pp] -> pp -- Each blob is parenthesised if necessary
pps -> parens (cat (punctuate (char '+') pps))
pps -> parens (hcat (punctuate (char '+') pps))
where
pp_hdrs hdr_pp [] = Nothing
pp_hdrs hdr_pp [SMRI(rep, n)] | n _EQ_ ILIT(1) = Just ((<>) (text (show rep)) hdr_pp)
......
......@@ -19,7 +19,7 @@ module BasicTypes(
SYN_IE(Version), SYN_IE(Arity),
SYN_IE(Module), moduleString, pprModule,
Fixity(..), FixityDirection(..),
NewOrData(..)
NewOrData(..), IfaceFlavour(..)
) where
IMP_Ubiq()
......@@ -67,6 +67,38 @@ pprModule :: PprStyle -> Module -> Doc
pprModule sty m = ptext m
\end{code}
%************************************************************************
%* *
\subsection[IfaceFlavour]{IfaceFlavour}
%* *
%************************************************************************
The IfaceFlavour type is used mainly in an imported Name's Provenance
to say whether the name comes from a regular .hi file, or whether it comes
from a hand-written .hi-boot file. This is important, because it has to be
propagated. Suppose
C.hs imports B
B.hs imports A
A.hs imports C {-# SOURCE -#} ( f )
Then in A.hi we may mention C.f, in an inlining. When compiling B we *must not*
read C.f's details from C.hi, even if the latter happens to exist from an earlier
compilation run. So we use the name "C!f" in A.hi, and when looking for an interface
file with details of C!f we look in C.hi-boot. The "!" stuff is recorded in the
IfaceFlavour in the Name of C.f in A.
Not particularly beautiful, but it works.
\begin{code}
data IfaceFlavour = HiFile -- The interface was read from a standard interface file
| HiBootFile -- ... or from a handwritten "hi-boot" interface file
instance Text IfaceFlavour where -- Just used in debug prints of lex tokens
showsPrec n HiFile s = s
showsPrec n HiBootFile s = "!" ++ s
\end{code}
%************************************************************************
%* *
......
......@@ -10,7 +10,7 @@ module FieldLabel where
IMP_Ubiq(){-uitous-}
import Name --( Name{-instance Eq/Outputable-}, nameUnique )
import Name ( Name{-instance Eq/Outputable-}, NamedThing(..), nameUnique )
import Type ( SYN_IE(Type) )
import Outputable
......
_interface_ Id 1
_exports_
Id Id GenId StrictnessMark(MarkedStrict NotMarkedStrict) dataConArgTys idType isNullaryDataCon mkDataCon mkTupleCon nmbrId pprId;
Id Id GenId StrictnessMark(MarkedStrict NotMarkedStrict) dataConArgTys idType isNullaryDataCon mkDataCon mkTupleCon pprId idName;
_declarations_
1 type Id = Id.GenId Type.Type ;
1 type Id = Id.GenId Type!Type ;
1 data GenId ty ;
1 data StrictnessMark = MarkedStrict | NotMarkedStrict ;
1 dataConArgTys _:_ Id.Id -> [Type.Type] -> [Type.Type] ;;
1 idType _:_ Id.Id -> Type.Type ;;
1 isNullaryDataCon _:_ Id.Id -> PrelBase.Bool ;;
1 mkDataCon _:_ Name.Name -> [Id.StrictnessMark] -> [FieldLabel.FieldLabel] -> [TyVar.TyVar] -> [(Class.Class,Type.Type)] -> [TyVar.TyVar] -> [(Class.Class,Type.Type)] -> [Type.Type] -> TyCon.TyCon -> Id.Id ;;
1 mkTupleCon _:_ PrelBase.Int -> Name.Name -> Type.Type -> Id.Id ;;
1 nmbrId _:_ Id.Id -> PprEnv.NmbrEnv -> (PprEnv.NmbrEnv, Id.Id) ;;
1 pprId _:_ _forall_ [ty] {Outputable.Outputable ty} => Outputable.PprStyle -> Id.GenId ty -> Pretty.Doc ;;
1 dataConArgTys _:_ Id -> [Type!Type] -> [Type!Type] ;;
1 idType _:_ Id.Id -> Type!Type ;;
1 isNullaryDataCon _:_ Id -> PrelBase.Bool ;;
1 mkDataCon _:_ Name.Name -> [Id.StrictnessMark] -> [FieldLabel.FieldLabel] -> [TyVar.TyVar] -> Type.ThetaType -> [TyVar.TyVar] -> Type!ThetaType -> [Type!TauType] -> TyCon!TyCon -> Id ;;
1 mkTupleCon _:_ PrelBase.Int -> Name.Name -> Type!Type -> Id ;;
1 pprId _:_ _forall_ [ty] {Outputable.Outputable ty} => Outputable.PprStyle -> GenId ty -> Pretty.Doc ;;
1 idName _:_ _forall_ [ty] => GenId ty -> Name.Name ;;
This diff is collapsed.
......@@ -26,7 +26,6 @@ module IdInfo (
StrictnessInfo(..), -- Non-abstract
Demand(..), NewOrData, -- Non-abstract
getWorkerId_maybe,
workerExists,
mkStrictnessInfo, mkBottomStrictnessInfo, noStrictnessInfo, bottomIsGuaranteed,
strictnessInfo, ppStrictnessInfo, addStrictnessInfo,
......@@ -63,7 +62,6 @@ import {-# SOURCE #-} CoreUnfold
import {-# SOURCE #-} StdIdInfo
#endif
import Type ( eqSimpleTy, splitFunTyExpandingDicts )
import BasicTypes ( NewOrData )
import CmdLineOpts ( opt_OmitInterfacePragmas )
......@@ -79,7 +77,6 @@ import Util ( mapAccumL, panic, assertPanic, pprPanic )
ord = fromEnum :: Char -> Int
#endif
applySubstToTy = panic "IdInfo.applySubstToTy"
showTypeCategory = panic "IdInfo.showTypeCategory"
\end{code}
......@@ -103,15 +100,11 @@ data IdInfo
DemandInfo -- Whether or not it is definitely
-- demanded
SpecEnv
-- Specialisations of this function which exist
SpecEnv -- Specialisations of this function which exist
(StrictnessInfo Id)
-- Strictness properties, notably
-- how to conjure up "worker" functions
StrictnessInfo -- Strictness properties
Unfolding
-- Its unfolding; for locally-defined
Unfolding -- Its unfolding; for locally-defined
-- things, this can *only* be NoUnfolding
UpdateInfo -- Which args should be updated
......@@ -139,39 +132,6 @@ apply_to_IdInfo ty_fn idinfo@(IdInfo arity demand spec strictness unfold
= idinfo
| otherwise
= panic "IdInfo:apply_to_IdInfo"
{- LATER:
let
new_spec = apply_spec spec
-- NOT a good idea:
-- apply_strict strictness `thenLft` \ new_strict ->
-- apply_wrap wrap `thenLft` \ new_wrap ->
in
IdInfo arity demand new_spec strictness unfold
update deforest arg_usage fb_ww
where
apply_spec (SpecEnv is)
= SpecEnv (map do_one is)
where
do_one (SpecInfo ty_maybes ds spec_id)
= --apply_to_Id ty_fn spec_id `thenLft` \ new_spec_id ->
SpecInfo (map apply_to_maybe ty_maybes) ds spec_id
where
apply_to_maybe Nothing = Nothing
apply_to_maybe (Just ty) = Just (ty_fn ty)
-}
{- NOT a good idea;
apply_strict info@NoStrictnessInfo = returnLft info
apply_strict BottomGuaranteed = ???
apply_strict (StrictnessInfo wrap_arg_info id_maybe)
= (case id_maybe of
Nothing -> returnLft Nothing
Just xx -> applySubstToId subst xx `thenLft` \ new_xx ->
returnLft (Just new_xx)
) `thenLft` \ new_id_maybe ->
returnLft (StrictnessInfo wrap_arg_info new_id_maybe)
-}
\end{code}
Variant of the same thing for the typechecker.
......@@ -179,23 +139,6 @@ Variant of the same thing for the typechecker.
applySubstToIdInfo s0 (IdInfo arity demand spec strictness unfold
update deforest arg_usage fb_ww)
= panic "IdInfo:applySubstToIdInfo"
{- LATER:
case (apply_spec s0 spec) of { (s1, new_spec) ->
(s1, IdInfo arity demand new_spec strictness unfold update deforest arg_usage fb_ww) }
where
apply_spec s0 (SpecEnv is)
= case (mapAccumL do_one s0 is) of { (s1, new_is) ->
(s1, SpecEnv new_is) }
where
do_one s0 (SpecInfo ty_maybes ds spec_id)
= case (mapAccumL apply_to_maybe s0 ty_maybes) of { (s1, new_maybes) ->
(s1, SpecInfo new_maybes ds spec_id) }
where
apply_to_maybe s0 Nothing = (s0, Nothing)
apply_to_maybe s0 (Just ty)
= case (applySubstToTy s0 ty) of { (s1, new_ty) ->
(s1, Just new_ty) }
-}
\end{code}
\begin{code}
......@@ -324,7 +267,7 @@ version of the function; and (c)~the type signature of that worker (if
it exists); i.e. its calling convention.
\begin{code}
data StrictnessInfo bdee
data StrictnessInfo
= NoStrictnessInfo
| BottomGuaranteed -- This Id guarantees never to return;
......@@ -332,25 +275,28 @@ data StrictnessInfo bdee
-- Useful for "error" and other disguised
-- variants thereof.
| StrictnessInfo [Demand] -- The main stuff; see below.
(Maybe (bdee,[bdee])) -- Worker's Id, if applicable, and a list of the constructors
-- mentioned by the wrapper. This is necessary so that the
-- renamer can slurp them in. Without this info, the renamer doesn't
-- know which data types to slurp in concretely. Remember, for
-- strict things we don't put the unfolding in the interface file, to save space.
-- This constructor list allows the renamer to behave much as if the
-- unfolding *was* in the interface file.
--
-- This field might be Nothing even for a strict fn because the strictness info
-- might say just "SSS" or something; so there's no w/w split.
| StrictnessInfo [Demand]
Bool -- True <=> there is a worker. There might not be, even for a
-- strict function, because:
-- (a) the function might be small enough to inline,
-- so no need for w/w split
-- (b) the strictness info might be "SSS" or something, so no w/w split.
-- Worker's Id, if applicable, and a list of the constructors
-- mentioned by the wrapper. This is necessary so that the
-- renamer can slurp them in. Without this info, the renamer doesn't
-- know which data types to slurp in concretely. Remember, for
-- strict things we don't put the unfolding in the interface file, to save space.
-- This constructor list allows the renamer to behave much as if the
-- unfolding *was* in the interface file.
\end{code}
\begin{code}
mkStrictnessInfo :: [Demand] -> Maybe (bdee,[bdee]) -> StrictnessInfo bdee
mkStrictnessInfo :: [Demand] -> Bool -> StrictnessInfo
mkStrictnessInfo xs wrkr
mkStrictnessInfo xs has_wrkr
| all is_lazy xs = NoStrictnessInfo -- Uninteresting
| otherwise = StrictnessInfo xs wrkr
| otherwise = StrictnessInfo xs has_wrkr
where
is_lazy (WwLazy False) = True -- NB "Absent" args do *not* count!
is_lazy _ = False -- (as they imply a worker)
......@@ -370,24 +316,14 @@ ppStrictnessInfo sty NoStrictnessInfo = empty
ppStrictnessInfo sty BottomGuaranteed = ptext SLIT("_bot_")
ppStrictnessInfo sty (StrictnessInfo wrapper_args wrkr_maybe)
= hsep [ptext SLIT("_S_"), text (showList wrapper_args ""), pp_wrkr]
where
pp_wrkr = case wrkr_maybe of
Nothing -> empty
Just (wrkr,cons) | ifaceStyle sty &&
not (null cons) -> pprId sty wrkr <+> braces (hsep (map (pprId sty) cons))
| otherwise -> pprId sty wrkr
= hsep [ptext SLIT("_S_"), text (showList wrapper_args "")]
\end{code}
\begin{code}
workerExists :: StrictnessInfo bdee -> Bool
workerExists (StrictnessInfo _ (Just worker_id)) = True
workerExists other = False
getWorkerId_maybe :: StrictnessInfo bdee -> Maybe bdee
getWorkerId_maybe (StrictnessInfo _ (Just (wrkr,_))) = Just wrkr
getWorkerId_maybe other = Nothing
workerExists :: StrictnessInfo -> Bool
workerExists (StrictnessInfo _ worker_exists) = worker_exists
workerExists other = False
\end{code}
......
......@@ -13,10 +13,11 @@ import CoreUnfold ( Unfolding(..), UnfoldingGuidance(..), mkUnfolding,
SimpleUnfolding(..), FormSummary(..), noUnfolding )
import CoreUtils ( unTagBinders )
import Id ( externallyVisibleId, isDataCon, isWorkerId, isWrapperId,
unfoldingUnfriendlyId, getIdInfo, nmbrId, pprId,
unfoldingUnfriendlyId, getIdInfo, nmbrId, pprId, idName,
nullIdEnv, lookupIdEnv, IdEnv(..),
Id(..), GenId
)
import Name ( Name )
import CostCentre ( CostCentre,
noCostCentre, subsumedCosts, cafifyCC,
useCurrentCostCentre, dontCareCostCentre,
......@@ -30,7 +31,6 @@ import Literal ( Literal )
import MagicUFs ( mkMagicUnfoldingFun, MagicUnfoldingFun )
import OccurAnal ( occurAnalyseGlobalExpr )
import Outputable ( Outputable(..), PprStyle )
import PprEnv ( NmbrEnv )
import PprType ( pprParendGenType )
import PragmaInfo ( PragmaInfo )
import Pretty ( Doc )
......@@ -54,9 +54,9 @@ isNullSpecEnv :: SpecEnv -> Bool
externallyVisibleId :: Id -> Bool
isDataCon :: GenId ty -> Bool
isWorkerId :: GenId ty -> Bool
nmbrId :: Id -> NmbrEnv -> (NmbrEnv, Id)
pprId :: Outputable ty => PprStyle -> GenId ty -> Doc
mkMagicUnfoldingFun :: Unique -> MagicUnfoldingFun
idName :: Id -> Name
type IdEnv a = UniqFM a
......@@ -75,7 +75,6 @@ instance (Eq a, Outputable a, Eq b, Outputable b) => Outputable (GenType a b)
data DemandInfo
data SpecEnv
data NmbrEnv
data MagicUnfoldingFun
data FormSummary = VarForm | ValueForm | BottomForm | OtherForm
......
......@@ -15,7 +15,7 @@ module Name (
OccName(..),
pprOccName, occNameString, occNameFlavour,
isTvOcc, isTCOcc, isVarOcc, prefixOccName,
quoteInText, parenInCode,
uniqToOccName,
-- The Name type
Name, -- Abstract
......@@ -44,7 +44,6 @@ module Name (
minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, isEmptyNameSet,
-- Misc
DefnInfo(..),
Provenance(..), pprProvenance,
ExportFlag(..),
......@@ -64,7 +63,7 @@ import {-# SOURCE #-} TyCon ( TyCon )
import CStrings ( identToC, modnameToC, cSEP )
import CmdLineOpts ( opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import BasicTypes ( SYN_IE(Module), moduleString, pprModule )
import BasicTypes ( SYN_IE(Module), IfaceFlavour(..), moduleString, pprModule )
import Outputable ( Outputable(..), PprStyle(..), codeStyle, ifaceStyle )
import PrelMods ( gHC__ )
......@@ -76,8 +75,7 @@ import Unique ( pprUnique, showUnique, Unique, Uniquable(..) )
import UniqSet ( UniqSet(..), emptyUniqSet, unitUniqSet, unionUniqSets, uniqSetToList, isEmptyUniqSet,
unionManyUniqSets, minusUniqSet, mkUniqSet, elementOfUniqSet, addListToUniqSet, addOneToUniqSet )
import UniqFM ( UniqFM )
import Util --( cmpPString, panic, assertPanic {-, pprTrace ToDo:rm-} )
import Util ( Ord3(..), cmpPString, panic, assertPanic {-, pprTrace ToDo:rm-} )
\end{code}
......@@ -126,7 +124,6 @@ isTvOcc other = False
isTCOcc (TCOcc s) = True
isTCOcc other = False
instance Eq OccName where
a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
......@@ -155,13 +152,6 @@ instance Outputable OccName where
\end{code}
\begin{code}
parenInCode, quoteInText :: OccName -> Bool
parenInCode occ = isLexSym (occNameString occ)
quoteInText occ = not (isLexSym (occNameString occ))
\end{code}
%************************************************************************
%* *
\subsection[Name-datatype]{The @Name@ datatype, and name construction}
......@@ -177,8 +167,7 @@ data Name
| Global Unique
Module -- The defining module
OccName -- Its name in that module
DefnInfo -- How it is defined
Provenance -- How it was brought into scope
Provenance -- How it was defined
\end{code}
Things with a @Global@ name are given C static labels, so they finally
......@@ -187,14 +176,14 @@ in the form M.n. If originally-local things have this property they
must be made @Global@ first.
\begin{code}
data DefnInfo = VanillaDefn
| WiredInTyCon TyCon -- There's a wired-in version
| WiredInId Id -- ...ditto...
data Provenance
= LocalDef ExportFlag SrcLoc -- Locally defined
| Imported Module SrcLoc -- Directly imported from M; gives locn of import statement
| Implicit -- Implicitly imported
= LocalDef ExportFlag SrcLoc -- Locally defined
| Imported Module SrcLoc IfaceFlavour -- Directly imported from M;
-- gives name of module in import statement
-- and locn of import statement
| Implicit IfaceFlavour -- Implicitly imported
| WiredInTyCon TyCon -- There's a wired-in version
| WiredInId Id -- ...ditto...
\end{code}
Something is "Exported" if it may be mentioned by another module without
......@@ -219,7 +208,7 @@ data ExportFlag = Exported | NotExported
mkLocalName :: Unique -> OccName -> SrcLoc -> Name
mkLocalName = Local
mkGlobalName :: Unique -> Module -> OccName -> DefnInfo -> Provenance -> Name
mkGlobalName :: Unique -> Module -> OccName -> Provenance -> Name
mkGlobalName = Global
mkSysLocalName :: Unique -> FAST_STRING -> SrcLoc -> Name
......@@ -227,11 +216,11 @@ mkSysLocalName uniq str loc = Local uniq (VarOcc str) loc
mkWiredInIdName :: Unique -> Module -> FAST_STRING -> Id -> Name
mkWiredInIdName uniq mod occ id
= Global uniq mod (VarOcc occ) (WiredInId id) Implicit
= Global uniq mod (VarOcc occ) (WiredInId id)
mkWiredInTyConName :: Unique -> Module -> FAST_STRING -> TyCon -> Name
mkWiredInTyConName uniq mod occ tycon
= Global uniq mod (TCOcc occ) (WiredInTyCon tycon) Implicit
= Global uniq mod (TCOcc occ) (WiredInTyCon tycon)
mkCompoundName :: (FAST_STRING -> FAST_STRING) -- Occurrence-name modifier
......@@ -239,8 +228,8 @@ mkCompoundName :: (FAST_STRING -> FAST_STRING) -- Occurrence-name modifier
-> Name -- Base name (must be a Global)
-> Name -- Result is always a value name
mkCompoundName str_fn uniq (Global _ mod occ defn prov)
= Global uniq mod new_occ defn prov
mkCompoundName str_fn uniq (Global _ mod occ prov)
= Global uniq mod new_occ prov
where
new_occ = VarOcc (str_fn (occNameString occ)) -- Always a VarOcc
......@@ -250,51 +239,95 @@ mkCompoundName str_fn uniq (Local _ occ loc)
-- Rather a wierd one that's used for names generated for instance decls
mkInstDeclName :: Unique -> Module -> OccName -> SrcLoc -> Bool -> Name
mkInstDeclName uniq mod occ loc from_here
= Global uniq mod occ VanillaDefn prov
= Global uniq mod occ prov
where
prov | from_here = LocalDef Exported loc
| otherwise = Implicit
| otherwise = Implicit HiFile -- Odd
setNameProvenance :: Name -> Provenance -> Name
-- setNameProvenance used to only change the provenance of Implicit-provenance things,
-- but that gives bad error messages for names defined twice in the same
-- module, so I changed it to set the proveance of *any* global (SLPJ Jun 97)
setNameProvenance (Global uniq mod occ def _) prov = Global uniq mod occ def prov
setNameProvenance other_name prov = other_name
setNameProvenance (Global uniq mod occ _) prov = Global uniq mod occ prov
setNameProvenance other_name prov = other_name
getNameProvenance :: Name -> Provenance
getNameProvenance (Global uniq mod occ def prov) = prov
getNameProvenance (Local uniq occ locn) = LocalDef NotExported locn
getNameProvenance (Global uniq mod occ prov) = prov
getNameProvenance (Local uniq occ locn) = LocalDef NotExported locn
-- When we renumber/rename things, we need to be
-- able to change a Name's Unique to match the cached
-- one in the thing it's the name of. If you know what I mean.
changeUnique (Local _ n l) u = Local u n l
changeUnique (Global _ mod occ def prov) u = Global u mod occ def prov
changeUnique (Global _ mod occ prov) u = Global u mod occ prov
\end{code}
setNameVisibility is applied to names in the final program
The Maybe Module argument is (Just mod) for top-level values,
and Nothing for all others (local values and type variables)
For top-level things, it globalises Local names
(if all top-level things should be visible)
and localises non-exported Global names
(if only exported things should be visible)
For nested things it localises Global names.
setNameVisibility :: Module -> Name -> Name
-- setNameVisibility is applied to top-level names in the final program
-- The "visibility" here concerns whether the .o file's symbol table
-- mentions the thing; if so, it needs a module name in its symbol,
-- otherwise we just use its unique. The Global things are "visible"
-- and the local ones are not
In all cases except an exported global, it gives it a new occurrence name.
setNameVisibility _ (Global uniq mod occ def (LocalDef NotExported loc))
| not all_toplev_ids_visible
= Local uniq occ loc
The "visibility" here concerns whether the .o file's symbol table
mentions the thing; if so, it needs a module name in its symbol.
The Global things are "visible" and the Local ones are not
setNameVisibility mod (Local uniq occ loc)
Why should things be "visible"? Certainly they must be if they
are exported. But also:
(a) In certain (prelude only) modules we split up the .hc file into
lots of separate little files, which are separately compiled by the C
compiler. That gives lots of little .o files. The idea is that if
you happen to mention one of them you don't necessarily pull them all
in. (Pulling in a piece you don't need can be v bad, because it may
mention other pieces you don't need either, and so on.)
Sadly, splitting up .hc files means that local names (like s234) are
now globally visible, which can lead to clashes between two .hc
files. So unlocaliseWhatnot goes through making all the local things
into global things, essentially by giving them full names so when they
are printed they'll have their module name too. Pretty revolting
really.
(b) When optimisation is on we want to make all the internal
top-level defns externally visible
\begin{code}
setNameVisibility :: Maybe Module -> Unique -> Name -> Name
setNameVisibility maybe_mod occ_uniq name@(Global uniq mod occ (LocalDef NotExported loc))
| not all_toplev_ids_visible || not_top_level maybe_mod
= Local uniq (uniqToOccName occ_uniq) loc -- Localise Global name
setNameVisibility maybe_mod occ_uniq name@(Global _ _ _ _)
= name -- Otherwise don't fiddle with Global
setNameVisibility (Just mod) occ_uniq (Local uniq occ loc)
| all_toplev_ids_visible
= Global uniq mod
(VarOcc (showUnique uniq)) -- It's local name must be unique!
VanillaDefn (LocalDef NotExported loc)
= Global uniq mod -- Globalise Local name
(uniqToOccName occ_uniq)
(LocalDef NotExported loc)
setNameVisibility maybe_mod occ_uniq (Local uniq occ loc)
= Local uniq (uniqToOccName occ_uniq) loc -- New OccName for Local
uniqToOccName uniq = VarOcc (_PK_ ('$':showUnique uniq))
-- The "$" is to make sure that this OccName is distinct from all user-defined ones
setNameVisibility mod name = name
not_top_level (Just m) = False
not_top_level Nothing = True
all_toplev_ids_visible = not opt_OmitInterfacePragmas || -- Pragmas can make them visible
opt_EnsureSplittableC -- Splitting requires visiblilty
\end{code}
%************************************************************************
......@@ -318,45 +351,45 @@ isLocalName :: Name -> Bool
nameUnique (Local u _ _) = u
nameUnique (Global u _ _ _ _) = u
nameUnique (Global u _ _ _) = u
nameOccName (Local _ occ _) = occ
nameOccName (Global _ _ occ _ _) = occ
nameOccName (Local _ occ _) = occ
nameOccName (Global _ _ occ _) = occ
nameModule (Global _ mod occ _ _) = mod
nameModule (Global _ mod occ _) = mod
nameModAndOcc (Global _ mod occ _ _) = (mod,occ)
nameModAndOcc (Global _ mod occ _) = (mod,occ)
nameString (Local _ occ _) = occNameString occ
nameString (Global _ mod occ _ _) = mod _APPEND_ SLIT(".") _APPEND_ occNameString occ
nameString (Local _ occ _) = occNameString occ
nameString (Global _ mod occ _) = mod _APPEND_ SLIT(".") _APPEND_ occNameString occ
isExportedName (Global _ _ _ _ (LocalDef Exported _)) = True
isExportedName other = False
isExportedName (Global _ _ _ (LocalDef Exported _)) = True
isExportedName other = False
nameSrcLoc (Local _ _ loc) = loc
nameSrcLoc (Global _ _ _ _ (LocalDef _ loc)) = loc
nameSrcLoc (Global _ _ _ _ (Imported _ loc)) = loc
nameSrcLoc (Global _ _ _ (LocalDef _ loc)) = loc
nameSrcLoc (Global _ _ _ (Imported _ loc _)) = loc
nameSrcLoc other = noSrcLoc
isLocallyDefinedName (Local _ _ _) = True
isLocallyDefinedName (Global _ _ _ _ (LocalDef _ _)) = True
isLocallyDefinedName other = False
isLocallyDefinedName (Global _ _ _ (LocalDef _ _)) = True
isLocallyDefinedName other = False
-- Things the compiler "knows about" are in some sense
-- "imported". When we are compiling the module where
-- the entities are defined, we need to be able to pick
-- them out, often in combination with isLocallyDefined.
isWiredInName (Global _ _ _ (WiredInTyCon _) _) = True
isWiredInName (Global _ _ _ (WiredInId _) _) = True
isWiredInName (Global _ _ _ (WiredInTyCon _)) = True
isWiredInName (Global _ _ _ (WiredInId _)) = True
isWiredInName _ = False
maybeWiredInIdName :: Name -> Maybe Id
maybeWiredInIdName (Global _ _ _ (WiredInId id) _) = Just id
maybeWiredInIdName other = Nothing
maybeWiredInIdName (Global _ _ _ (WiredInId id)) = Just id
maybeWiredInIdName other = Nothing
maybeWiredInTyConName :: Name -> Maybe TyCon
maybeWiredInTyConName (Global _ _ _ (WiredInTyCon tc) _) = Just tc
maybeWiredInTyConName other = Nothing
maybeWiredInTyConName (Global _ _ _ (WiredInTyCon tc)) = Just tc
maybeWiredInTyConName other = Nothing
isLocalName (Local _ _ _) = True
......@@ -373,10 +406,10 @@ isLocalName _ = False
\begin{code}
cmpName n1 n2 = c n1 n2
where
c (Local u1 _ _) (Local u2 _ _) = cmp u1 u2
c (Local _ _ _) _ = LT_
c (Global u1 _ _ _ _) (Global u2 _ _ _ _) = cmp u1 u2
c (Global _ _ _ _ _) _ = GT_
c (Local u1 _ _) (Local u2 _ _) = cmp u1 u2
c (Local _ _ _) _ = LT_
c (Global u1 _ _ _) (Global u2 _ _ _) = cmp u1 u2
c (Global _ _ _ _) _ = GT_
\end{code}
\begin{code}
......@@ -410,49 +443,59 @@ instance NamedThing Name where
\begin{code}
instance Outputable Name where
ppr PprQuote name@(Local _ _ _) = quotes (ppr (PprForUser 1) name)
ppr (PprForUser _) (Local _ n _) = ptext (occNameString n)
ppr PprQuote name@(Local _ _ _) = quotes (ppr (PprForUser 1) name)
-- When printing interfaces, all Locals have been given nice print-names
ppr (PprForUser _) (Local _ n _) = ptext (occNameString n)
ppr PprInterface (Local _ n _) = ptext (occNameString n)
ppr sty (Local u n _) | codeStyle sty ||
ifaceStyle sty = pprUnique u
ppr sty (Local u n _) | codeStyle sty = pprUnique u
ppr sty (Local u n _) = hcat [ptext (occNameString n), ptext SLIT("_"), pprUnique u]