Commit 990dd09b authored by simonpj's avatar simonpj
Browse files

[project @ 2002-06-14 14:03:25 by simonpj]

---------------------------------------
	Utterly expunge the tyGenInfo field of
			an IdInfo
	---------------------------------------

tyGenInfo was a relic of a previous version of Keith's usage
analyser.  It's just dead code, so I've nuked it.
parent c5a96ed0
......@@ -46,7 +46,6 @@ module Id (
setIdArity,
setIdNewDemandInfo,
setIdNewStrictness, zapIdNewStrictness,
setIdTyGenInfo,
setIdWorkerInfo,
setIdSpecialisation,
setIdCgInfo,
......@@ -64,7 +63,6 @@ module Id (
idArity,
idNewDemandInfo, idNewDemandInfo_maybe,
idNewStrictness, idNewStrictness_maybe,
idTyGenInfo,
idWorkerInfo,
idUnfolding,
idSpecialisation, idCoreRules,
......@@ -118,7 +116,6 @@ infixl 1 `setIdUnfolding`,
`setIdArity`,
`setIdNewDemandInfo`,
`setIdNewStrictness`,
`setIdTyGenInfo`,
`setIdWorkerInfo`,
`setIdSpecialisation`,
`setInlinePragma`,
......@@ -349,14 +346,6 @@ setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
zapIdNewStrictness :: Id -> Id
zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
---------------------------------
-- TYPE GENERALISATION
idTyGenInfo :: Id -> TyGenInfo
idTyGenInfo id = tyGenInfo (idInfo id)
setIdTyGenInfo :: Id -> TyGenInfo -> Id
setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) id
---------------------------------
-- WORKER ID
idWorkerInfo :: Id -> WorkerInfo
......
......@@ -11,7 +11,7 @@ module IdInfo (
GlobalIdDetails(..), notGlobalId, -- Not abstract
IdInfo, -- Abstract
vanillaIdInfo, noCafNoTyGenIdInfo,
vanillaIdInfo, noCafIdInfo,
seqIdInfo, megaSeqIdInfo,
-- Zapping
......@@ -33,11 +33,6 @@ module IdInfo (
ppStrictnessInfo,isBottomingStrictness,
setAllStrictnessInfo,
-- Usage generalisation
TyGenInfo(..),
tyGenInfo, setTyGenInfo,
noTyGenInfo, isNoTyGenInfo, ppTyGenInfo, tyGenInfoString,
-- Worker
WorkerInfo(..), workerExists, wrapperArity, workerId,
workerInfo, setWorkerInfo, ppWorkerInfo,
......@@ -109,8 +104,7 @@ import Maybe ( isJust )
import List ( replicate )
-- infixl so you can say (id `set` a `set` b)
infixl 1 `setTyGenInfo`,
`setSpecInfo`,
infixl 1 `setSpecInfo`,
`setArityInfo`,
`setInlinePragInfo`,
`setUnfoldingInfo`,
......@@ -286,7 +280,6 @@ data IdInfo
= IdInfo {
arityInfo :: !ArityInfo, -- Its arity
specInfo :: CoreRules, -- Specialisations of this function which exist
tyGenInfo :: TyGenInfo, -- Restrictions on usage-generalisation of this Id
#ifdef OLD_STRICTNESS
cprInfo :: CprInfo, -- Function always constructs a product result
demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded
......@@ -315,7 +308,6 @@ seqIdInfo (IdInfo {}) = ()
megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo info
= seqRules (specInfo info) `seq`
seqTyGenInfo (tyGenInfo info) `seq`
seqWorker (workerInfo info) `seq`
-- Omitting this improves runtimes a little, presumably because
......@@ -343,7 +335,6 @@ Setters
\begin{code}
setWorkerInfo info wk = wk `seq` info { workerInfo = wk }
setSpecInfo info sp = sp `seq` info { specInfo = sp }
setTyGenInfo info tg = tg `seq` info { tyGenInfo = tg }
setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
setOccInfo info oc = oc `seq` info { occInfo = oc }
#ifdef OLD_STRICTNESS
......@@ -396,7 +387,6 @@ vanillaIdInfo
strictnessInfo = NoStrictnessInfo,
#endif
specInfo = emptyCoreRules,
tyGenInfo = noTyGenInfo,
workerInfo = NoWorker,
unfoldingInfo = noUnfolding,
lbvarInfo = NoLBVarInfo,
......@@ -406,8 +396,7 @@ vanillaIdInfo
newStrictnessInfo = Nothing
}
noCafNoTyGenIdInfo = vanillaIdInfo `setTyGenInfo` TyGenNever
`setCgInfo` CgInfo NoCafRefs
noCafIdInfo = vanillaIdInfo `setCgInfo` CgInfo NoCafRefs
-- Used for built-in type Ids in MkId.
-- Many built-in things have fixed types, so we shouldn't
-- run around generalising them
......@@ -457,81 +446,6 @@ type InlinePragInfo = Activation
\end{code}
%************************************************************************
%* *
\subsection[TyGen-IdInfo]{Type generalisation info about an @Id@}
%* *
%************************************************************************
Certain passes (notably usage inference) may change the type of an
identifier, modifying all in-scope uses of that identifier
appropriately to maintain type safety.
However, some identifiers must not have their types changed in this
way, because their types are conjured up in the front end of the
compiler rather than being read from the interface file. Default
methods, dictionary functions, record selectors, and others are in
this category. (see comment at TcClassDcl.tcClassSig).
To indicate this property, such identifiers are marked TyGenNever.
Furthermore, if the usage inference generates a usage-specialised
variant of a function, we must NOT re-infer a fully-generalised type
at the next inference. This finer property is indicated by a
TyGenUInfo on the identifier.
\begin{code}
data TyGenInfo
= NoTyGenInfo -- no restriction on type generalisation
| TyGenUInfo [Maybe Type] -- restrict generalisation of this Id to
-- preserve specified usage annotations
| TyGenNever -- never generalise the type of this Id
\end{code}
For TyGenUInfo, the list has one entry for each usage annotation on
the type of the Id, in left-to-right pre-order (annotations come
before the type they annotate). Nothing means no restriction; Just
usOnce or Just usMany forces that annotation to that value. Other
usage annotations are illegal.
\begin{code}
seqTyGenInfo :: TyGenInfo -> ()
seqTyGenInfo NoTyGenInfo = ()
seqTyGenInfo (TyGenUInfo us) = seqList us ()
seqTyGenInfo TyGenNever = ()
noTyGenInfo :: TyGenInfo
noTyGenInfo = NoTyGenInfo
isNoTyGenInfo :: TyGenInfo -> Bool
isNoTyGenInfo NoTyGenInfo = True
isNoTyGenInfo _ = False
-- NB: There's probably no need to write this information out to the interface file.
-- Why? Simply because imported identifiers never get their types re-inferred.
-- But it's definitely nice to see in dumps, it for debugging purposes.
ppTyGenInfo :: TyGenInfo -> SDoc
ppTyGenInfo NoTyGenInfo = empty
ppTyGenInfo (TyGenUInfo us) = ptext SLIT("__G") <+> text (tyGenInfoString us)
ppTyGenInfo TyGenNever = ptext SLIT("__G N")
tyGenInfoString us = map go us
where go Nothing = 'x' -- for legibility, choose
go (Just u) | u `eqUsage` usOnce = '1' -- chars with identity
| u `eqUsage` usMany = 'M' -- Z-encoding.
go other = pprPanic "IdInfo.tyGenInfoString: unexpected annotation" (ppr other)
instance Outputable TyGenInfo where
ppr = ppTyGenInfo
instance Show TyGenInfo where
showsPrec p c = showsPrecSDoc p (ppr c)
\end{code}
%************************************************************************
%* *
\subsection[worker-IdInfo]{Worker info about an @Id@}
......
......@@ -73,7 +73,7 @@ import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
mkTemplateLocals, mkTemplateLocalsNum,
mkTemplateLocal, idNewStrictness, idName
)
import IdInfo ( IdInfo, noCafNoTyGenIdInfo,
import IdInfo ( IdInfo, noCafIdInfo,
setUnfoldingInfo,
setArityInfo, setSpecInfo, setCafInfo,
setAllStrictnessInfo,
......@@ -156,7 +156,7 @@ mkDataConId :: Name -> DataCon -> Id
mkDataConId work_name data_con
= mkGlobalId (DataConId data_con) work_name (dataConRepType data_con) info
where
info = noCafNoTyGenIdInfo
info = noCafIdInfo
`setArityInfo` arity
`setAllStrictnessInfo` Just strict_sig
......@@ -243,9 +243,9 @@ mkDataConWrapId data_con
where
work_id = dataConWorkId data_con
info = noCafNoTyGenIdInfo
info = noCafIdInfo
`setUnfoldingInfo` wrap_unf
-- The NoCaf-ness is set by noCafNoTyGenIdInfo
-- The NoCaf-ness is set by noCafIdInfo
`setArityInfo` arity
-- It's important to specify the arity, so that partial
-- applications are treated as values
......@@ -455,7 +455,7 @@ mkRecordSelId tycon field_label
-- Use the demand analyser to work out strictness.
-- With all this unpackery it's not easy!
info = noCafNoTyGenIdInfo
info = noCafIdInfo
`setCafInfo` caf_info
`setArityInfo` arity
`setUnfoldingInfo` mkTopUnfolding rhs_w_str
......@@ -606,7 +606,7 @@ mkDictSelId name clas
field_lbl = mkFieldLabel name tycon sel_ty tag
tag = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` allFieldLabelTags) name
info = noCafNoTyGenIdInfo
info = noCafIdInfo
`setArityInfo` 1
`setUnfoldingInfo` mkTopUnfolding rhs
`setAllStrictnessInfo` Just strict_sig
......@@ -666,7 +666,7 @@ mkPrimOpId prim_op
name = mkPrimOpIdName prim_op
id = mkGlobalId (PrimOpId prim_op) name ty info
info = noCafNoTyGenIdInfo
info = noCafIdInfo
`setSpecInfo` rules
`setArityInfo` arity
`setAllStrictnessInfo` Just strict_sig
......@@ -696,7 +696,7 @@ mkFCallId uniq fcall ty
name = mkFCallName uniq occ_str
info = noCafNoTyGenIdInfo
info = noCafIdInfo
`setArityInfo` arity
`setAllStrictnessInfo` Just strict_sig
......@@ -740,7 +740,7 @@ BUT make sure they are *exported* LocalIds (setIdLocalExported) so
that they aren't discarded by the occurrence analyser.
\begin{code}
mkDefaultMethodId dm_name ty = mkVanillaGlobal dm_name ty noCafNoTyGenIdInfo
mkDefaultMethodId dm_name ty = mkVanillaGlobal dm_name ty noCafIdInfo
mkDictFunId :: Name -- Name to use for the dict fun;
-> Class
......@@ -750,7 +750,7 @@ mkDictFunId :: Name -- Name to use for the dict fun;
-> Id
mkDictFunId dfun_name clas inst_tyvars inst_tys dfun_theta
= mkVanillaGlobal dfun_name dfun_ty noCafNoTyGenIdInfo
= mkVanillaGlobal dfun_name dfun_ty noCafIdInfo
where
dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
......@@ -810,7 +810,7 @@ another gun with which to shoot yourself in the foot.
unsafeCoerceId
= pcMiscPrelId unsafeCoerceIdKey gHC_PRIM FSLIT("unsafeCoerce#") ty info
where
info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
......@@ -825,13 +825,13 @@ unsafeCoerceId
nullAddrId
= pcMiscPrelId nullAddrIdKey gHC_PRIM FSLIT("nullAddr#") addrPrimTy info
where
info = noCafNoTyGenIdInfo `setUnfoldingInfo`
info = noCafIdInfo `setUnfoldingInfo`
mkCompulsoryUnfolding (Lit nullAddrLit)
seqId
= pcMiscPrelId seqIdKey gHC_PRIM FSLIT("seq") ty info
where
info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
ty = mkForAllTys [alphaTyVar,betaTyVar]
......@@ -847,7 +847,7 @@ evaluate its argument and call the dataToTag# primitive.
getTagId
= pcMiscPrelId getTagIdKey gHC_PRIM FSLIT("getTag#") ty info
where
info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
-- We don't provide a defn for this; you must inline it
ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
......@@ -872,7 +872,7 @@ This comes up in strictness analysis
realWorldPrimId -- :: State# RealWorld
= pcMiscPrelId realWorldPrimIdKey gHC_PRIM FSLIT("realWorld#")
realWorldStatePrimTy
(noCafNoTyGenIdInfo `setUnfoldingInfo` mkOtherCon [])
(noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
-- The mkOtherCon makes it look that realWorld# is evaluated
-- which in turn makes Simplify.interestingArg return True,
-- which in turn makes INLINE things applied to realWorld# likely
......@@ -966,7 +966,7 @@ pc_bottoming_Id key mod name ty
= pcMiscPrelId key mod name ty bottoming_info
where
strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
bottoming_info = noCafNoTyGenIdInfo `setAllStrictnessInfo` Just strict_sig
bottoming_info = noCafIdInfo `setAllStrictnessInfo` Just strict_sig
-- these "bottom" out, no matter what their arguments
(openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
......
......@@ -32,7 +32,6 @@ import IdInfo ( IdInfo, megaSeqIdInfo,
arityInfo, ppArityInfo,
specInfo, ppStrictnessInfo,
workerInfo, ppWorkerInfo,
tyGenInfo, ppTyGenInfo,
newStrictnessInfo,
#ifdef OLD_STRICTNESS
cprInfo, ppCprInfo,
......@@ -354,7 +353,6 @@ pprIdDetails id | isGlobalId id = ppr (globalIdDetails id)
ppIdInfo :: Id -> IdInfo -> SDoc
ppIdInfo b info
= hsep [ ppArityInfo a,
ppTyGenInfo g,
ppWorkerInfo (workerInfo info),
#ifdef OLD_STRICTNESS
ppStrictnessInfo s,
......@@ -368,7 +366,6 @@ ppIdInfo b info
]
where
a = arityInfo info
g = tyGenInfo info
#ifdef OLD_STRICTNESS
s = strictnessInfo info
m = cprInfo info
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment