From 990dd09b4303a31ffdfc0a696ff9162ccd0e8960 Mon Sep 17 00:00:00 2001 From: simonpj Date: Fri, 14 Jun 2002 14:03:27 +0000 Subject: [PATCH] [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. --- ghc/compiler/basicTypes/Id.lhs | 11 ----- ghc/compiler/basicTypes/IdInfo.lhs | 92 ++---------------------------------- ghc/compiler/basicTypes/MkId.lhs | 32 ++++++------- ghc/compiler/coreSyn/PprCore.lhs | 3 -- 4 files changed, 19 insertions(+), 119 deletions(-) diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs index 9f07786..45b8b42 100644 --- a/ghc/compiler/basicTypes/Id.lhs +++ b/ghc/compiler/basicTypes/Id.lhs @@ -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`, @@ -350,14 +347,6 @@ 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 idWorkerInfo id = workerInfo (idInfo id) diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 6a7ff62..18980bc 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -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 @@ -458,81 +447,6 @@ type InlinePragInfo = Activation %************************************************************************ -%* * -\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@} %* * diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs index e83e491..9382d57 100644 --- a/ghc/compiler/basicTypes/MkId.lhs +++ b/ghc/compiler/basicTypes/MkId.lhs @@ -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 diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs index d6b3a6e..3c65bac 100644 --- a/ghc/compiler/coreSyn/PprCore.lhs +++ b/ghc/compiler/coreSyn/PprCore.lhs @@ -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 -- 1.7.10.4