X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FId.lhs;h=fbf6b4a25644ba63f9fc95c7a86680152d4631c1;hp=154275b421d7925544c07fc4747945dfee349d44;hb=294dab1b04599cd7628642b0fe02e088ac3da4ba;hpb=2e06595241350a6548b6ab6430c65d6458f7c197 diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs index 154275b..fbf6b4a 100644 --- a/compiler/basicTypes/Id.lhs +++ b/compiler/basicTypes/Id.lhs @@ -27,35 +27,39 @@ module Id ( -- ** Simple construction mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo, - mkLocalId, mkLocalIdWithInfo, + mkLocalId, mkLocalIdWithInfo, mkExportedLocalId, mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM, - mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal, - mkWorkerId, mkExportedLocalId, + mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal, + mkWorkerId, -- ** Taking an Id apart - idName, idType, idUnique, idInfo, - isId, globalIdDetails, idPrimRep, + idName, idType, idUnique, idInfo, idDetails, + isId, idPrimRep, recordSelectorFieldLabel, -- ** Modifying an Id - setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported, - globaliseId, setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, + setIdName, setIdUnique, Id.setIdType, + setIdExported, setIdNotExported, + globaliseId, localiseId, + setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, transferPolyIdInfo, + -- ** Predicates on Ids isImplicitId, isDeadBinder, isDictId, isStrictId, isExportedId, isLocalId, isGlobalId, isRecordSelector, isNaughtyRecordSelector, - isClassOpId_maybe, + isClassOpId_maybe, isDFunId, isPrimOpId, isPrimOpId_maybe, isFCallId, isFCallId_maybe, isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon, - isBottomingId, idIsFrom, + isConLikeId, isBottomingId, idIsFrom, isTickBoxOp, isTickBoxOp_maybe, hasNoBinding, -- ** Inline pragma stuff - idInlinePragma, setInlinePragma, modifyInlinePragma, + idInlinePragma, setInlinePragma, modifyInlinePragma, + idInlineActivation, setInlineActivation, idRuleMatchInfo, -- ** One-shot lambdas isOneShotBndr, isOneShotLambda, isStateHackType, @@ -63,83 +67,67 @@ module Id ( -- ** Reading 'IdInfo' fields idArity, - idNewDemandInfo, idNewDemandInfo_maybe, - idNewStrictness, idNewStrictness_maybe, - idWorkerInfo, - idUnfolding, + idDemandInfo, idDemandInfo_maybe, + idStrictness, idStrictness_maybe, + idUnfolding, realIdUnfolding, idSpecialisation, idCoreRules, idHasRules, idCafInfo, idLBVarInfo, idOccInfo, -#ifdef OLD_STRICTNESS - idDemandInfo, - idStrictness, - idCprInfo, -#endif - -- ** Writing 'IdInfo' fields setIdUnfolding, setIdArity, - setIdNewDemandInfo, - setIdNewStrictness, zapIdNewStrictness, - setIdWorkerInfo, + setIdDemandInfo, + setIdStrictness, zapIdStrictness, setIdSpecialisation, setIdCafInfo, - setIdOccInfo, + setIdOccInfo, zapIdOccInfo, -#ifdef OLD_STRICTNESS - setIdStrictness, - setIdDemandInfo, - setIdCprInfo, -#endif ) where #include "HsVersions.h" -import CoreSyn ( CoreRule, Unfolding ) +import CoreSyn ( CoreRule, Unfolding( NoUnfolding ) ) import IdInfo import BasicTypes + +-- Imported and re-exported +import Var( Var, Id, DictId, + idInfo, idDetails, globaliseId, + isId, isLocalId, isGlobalId, isExportedId ) import qualified Var -import Var + import TyCon import Type -import TcType import TysPrim -#ifdef OLD_STRICTNESS -import qualified Demand -#endif import DataCon -import NewDemand +import Demand import Name import Module import Class import PrimOp import ForeignCall -import OccName import Maybes import SrcLoc import Outputable import Unique import UniqSupply import FastString +import Util( count ) import StaticFlags -- infixl so you can say (id `set` a `set` b) infixl 1 `setIdUnfolding`, `setIdArity`, - `setIdNewDemandInfo`, - `setIdNewStrictness`, - `setIdWorkerInfo`, + `setIdOccInfo`, + `setIdDemandInfo`, + `setIdStrictness`, `setIdSpecialisation`, `setInlinePragma`, + `setInlineActivation`, `idCafInfo` -#ifdef OLD_STRICTNESS - ,`idCprInfo` - ,`setIdStrictness` - ,`setIdDemandInfo` -#endif \end{code} %************************************************************************ @@ -153,26 +141,19 @@ idName :: Id -> Name idName = Var.varName idUnique :: Id -> Unique -idUnique = varUnique +idUnique = Var.varUnique idType :: Id -> Kind -idType = varType - -idInfo :: Id -> IdInfo -idInfo = varIdInfo +idType = Var.varType idPrimRep :: Id -> PrimRep idPrimRep id = typePrimRep (idType id) -globalIdDetails :: Id -> GlobalIdDetails -globalIdDetails = globalIdVarDetails - - setIdName :: Id -> Name -> Id -setIdName = setVarName +setIdName = Var.setVarName setIdUnique :: Id -> Unique -> Id -setIdUnique = setVarUnique +setIdUnique = Var.setVarUnique -- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and -- reduce space usage @@ -180,16 +161,24 @@ setIdType :: Id -> Type -> Id setIdType id ty = seqType ty `seq` Var.setVarType id ty setIdExported :: Id -> Id -setIdExported = setIdVarExported +setIdExported = Var.setIdExported setIdNotExported :: Id -> Id -setIdNotExported = setIdVarNotExported - -globaliseId :: GlobalIdDetails -> Id -> Id -globaliseId = globaliseIdVar +setIdNotExported = Var.setIdNotExported + +localiseId :: Id -> Id +-- Make an with the same unique and type as the +-- incoming Id, but with an *Internal* Name and *LocalId* flavour +localiseId id + | isLocalId id && isInternalName name + = id + | otherwise + = mkLocalIdWithInfo (localiseName name) (idType id) (idInfo id) + where + name = idName id lazySetIdInfo :: Id -> IdInfo -> Id -lazySetIdInfo = lazySetVarIdInfo +lazySetIdInfo = Var.lazySetIdInfo setIdInfo :: Id -> IdInfo -> Id setIdInfo id info = seqIdInfo info `seq` (lazySetIdInfo id info) @@ -226,8 +215,8 @@ Anyway, we removed it in March 2008. \begin{code} -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal" -mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id -mkGlobalId = mkGlobalIdVar +mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id +mkGlobalId = Var.mkGlobalVar -- | Make a global 'Id' without any extra information at all mkVanillaGlobal :: Name -> Type -> Id @@ -235,7 +224,7 @@ mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo -- | Make a global 'Id' with no global information but some generic 'IdInfo' mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id -mkVanillaGlobalWithInfo = mkGlobalId VanillaGlobal +mkVanillaGlobalWithInfo = mkGlobalId VanillaId -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal" @@ -243,16 +232,18 @@ mkLocalId :: Name -> Type -> Id mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id -mkLocalIdWithInfo = mkLocalIdVar +mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info -- Note [Free type variables] --- | Create a local 'Id' that is marked as exported. This prevents things attached to it from being removed as dead code. +-- | Create a local 'Id' that is marked as exported. +-- This prevents things attached to it from being removed as dead code. mkExportedLocalId :: Name -> Type -> Id -mkExportedLocalId name ty = mkExportedLocalIdVar name ty vanillaIdInfo +mkExportedLocalId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo -- Note [Free type variables] --- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal") that are created by the compiler out of thin air +-- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal") +-- that are created by the compiler out of thin air mkSysLocal :: FastString -> Unique -> Type -> Id mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty @@ -274,16 +265,10 @@ Make some local @Ids@ for a template @CoreExpr@. These have bogus instantiated before use. \begin{code} --- | Make a /wild Id/. This is typically used when you need a binder that you don't expect to use -mkWildId :: Type -> Id -mkWildId ty = mkSysLocal (fsLit "wild") (mkBuiltinUnique 1) ty - -- | Workers get local names. "CoreTidy" will externalise these if necessary mkWorkerId :: Unique -> Id -> Type -> Id mkWorkerId uniq unwrkr ty - = mkLocalId wkr_name ty - where - wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcSpan unwrkr) + = mkLocalId (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty -- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings mkTemplateLocal :: Int -> Type -> Id @@ -301,29 +286,6 @@ mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys %************************************************************************ %* * -\subsection{Basic predicates on @Id@s} -%* * -%************************************************************************ - -\begin{code} -isId :: Id -> Bool -isId = isIdVar - --- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal" -isLocalId :: Id -> Bool -isLocalId = isLocalIdVar - --- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal" -isGlobalId :: Id -> Bool -isGlobalId = isGlobalIdVar - --- | Determines whether an 'Id' is marked as exported and hence will not be considered dead code -isExportedId :: Id -> Bool -isExportedId = isExportedIdVar -\end{code} - -%************************************************************************ -%* * \subsection{Special Ids} %* * %************************************************************************ @@ -332,8 +294,8 @@ isExportedId = isExportedIdVar -- | If the 'Id' is that for a record selector, extract the 'sel_tycon' and label. Panic otherwise recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel) recordSelectorFieldLabel id - = case globalIdDetails id of - RecordSelId { sel_tycon = tycon, sel_label = lbl } -> (tycon,lbl) + = case Var.idDetails id of + RecSelId { sel_tycon = tycon } -> (tycon, idName id) _ -> panic "recordSelectorFieldLabel" isRecordSelector :: Id -> Bool @@ -341,50 +303,55 @@ isNaughtyRecordSelector :: Id -> Bool isPrimOpId :: Id -> Bool isFCallId :: Id -> Bool isDataConWorkId :: Id -> Bool +isDFunId :: Id -> Bool isClassOpId_maybe :: Id -> Maybe Class isPrimOpId_maybe :: Id -> Maybe PrimOp isFCallId_maybe :: Id -> Maybe ForeignCall isDataConWorkId_maybe :: Id -> Maybe DataCon -isRecordSelector id = case globalIdDetails id of - RecordSelId {} -> True +isRecordSelector id = case Var.idDetails id of + RecSelId {} -> True _ -> False -isNaughtyRecordSelector id = case globalIdDetails id of - RecordSelId { sel_naughty = n } -> n +isNaughtyRecordSelector id = case Var.idDetails id of + RecSelId { sel_naughty = n } -> n _ -> False -isClassOpId_maybe id = case globalIdDetails id of +isClassOpId_maybe id = case Var.idDetails id of ClassOpId cls -> Just cls _other -> Nothing -isPrimOpId id = case globalIdDetails id of +isPrimOpId id = case Var.idDetails id of PrimOpId _ -> True _ -> False -isPrimOpId_maybe id = case globalIdDetails id of +isDFunId id = case Var.idDetails id of + DFunId _ -> True + _ -> False + +isPrimOpId_maybe id = case Var.idDetails id of PrimOpId op -> Just op _ -> Nothing -isFCallId id = case globalIdDetails id of +isFCallId id = case Var.idDetails id of FCallId _ -> True _ -> False -isFCallId_maybe id = case globalIdDetails id of +isFCallId_maybe id = case Var.idDetails id of FCallId call -> Just call _ -> Nothing -isDataConWorkId id = case globalIdDetails id of +isDataConWorkId id = case Var.idDetails id of DataConWorkId _ -> True _ -> False -isDataConWorkId_maybe id = case globalIdDetails id of +isDataConWorkId_maybe id = case Var.idDetails id of DataConWorkId con -> Just con _ -> Nothing isDataConId_maybe :: Id -> Maybe DataCon -isDataConId_maybe id = case globalIdDetails id of +isDataConId_maybe id = case Var.idDetails id of DataConWorkId con -> Just con DataConWrapId con -> Just con _ -> Nothing @@ -407,7 +374,7 @@ hasNoBinding :: Id -> Bool -- they aren't any more. Instead, we inject a binding for -- them at the CorePrep stage. -- EXCEPT: unboxed tuples, which definitely have no binding -hasNoBinding id = case globalIdDetails id of +hasNoBinding id = case Var.idDetails id of PrimOpId _ -> True -- See Note [Primop wrappers] FCallId _ -> True DataConWorkId dc -> isUnboxedTupleCon dc @@ -418,13 +385,12 @@ isImplicitId :: Id -> Bool -- declarations, so we don't need to put its signature in an interface -- file, even if it's mentioned in some other interface unfolding. isImplicitId id - = case globalIdDetails id of - RecordSelId {} -> True - FCallId _ -> True - PrimOpId _ -> True - ClassOpId _ -> True - DataConWorkId _ -> True - DataConWrapId _ -> True + = case Var.idDetails id of + FCallId {} -> True + ClassOpId {} -> True + PrimOpId {} -> True + DataConWorkId {} -> True + DataConWrapId {} -> True -- These are are implied by their type or class decl; -- remember that all type and class decls appear in the interface file. -- The dfun id is not an implicit Id; it must *not* be omitted, because @@ -459,13 +425,13 @@ isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr) \begin{code} isTickBoxOp :: Id -> Bool isTickBoxOp id = - case globalIdDetails id of + case Var.idDetails id of TickBoxOpId _ -> True _ -> False isTickBoxOp_maybe :: Id -> Maybe TickBoxOp isTickBoxOp_maybe id = - case globalIdDetails id of + case Var.idDetails id of TickBoxOpId tick -> Just tick _ -> Nothing \end{code} @@ -485,31 +451,21 @@ idArity id = arityInfo (idInfo id) setIdArity :: Id -> Arity -> Id setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id -#ifdef OLD_STRICTNESS - --------------------------------- - -- (OLD) STRICTNESS -idStrictness :: Id -> StrictnessInfo -idStrictness id = strictnessInfo (idInfo id) - -setIdStrictness :: Id -> StrictnessInfo -> Id -setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id -#endif - -- | Returns true if an application to n args would diverge isBottomingId :: Id -> Bool -isBottomingId id = isBottomingSig (idNewStrictness id) +isBottomingId id = isBottomingSig (idStrictness id) -idNewStrictness_maybe :: Id -> Maybe StrictSig -idNewStrictness :: Id -> StrictSig +idStrictness_maybe :: Id -> Maybe StrictSig +idStrictness :: Id -> StrictSig -idNewStrictness_maybe id = newStrictnessInfo (idInfo id) -idNewStrictness id = idNewStrictness_maybe id `orElse` topSig +idStrictness_maybe id = strictnessInfo (idInfo id) +idStrictness id = idStrictness_maybe id `orElse` topSig -setIdNewStrictness :: Id -> StrictSig -> Id -setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id +setIdStrictness :: Id -> StrictSig -> Id +setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` Just sig) id -zapIdNewStrictness :: Id -> Id -zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id +zapIdStrictness :: Id -> Id +zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` Nothing) id -- | This predicate says whether the 'Id' has a strict demand placed on it or -- has a type such that it can always be evaluated strictly (e.g., an @@ -520,46 +476,40 @@ zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id isStrictId :: Id -> Bool isStrictId id = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id ) - (isStrictDmd (idNewDemandInfo id)) || + (isStrictDmd (idDemandInfo id)) || (isStrictType (idType id)) --------------------------------- - -- WORKER ID -idWorkerInfo :: Id -> WorkerInfo -idWorkerInfo id = workerInfo (idInfo id) - -setIdWorkerInfo :: Id -> WorkerInfo -> Id -setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id - - --------------------------------- -- UNFOLDING idUnfolding :: Id -> Unfolding -idUnfolding id = unfoldingInfo (idInfo id) +-- Do not expose the unfolding of a loop breaker! +idUnfolding id + | isNonRuleLoopBreaker (occInfo info) = NoUnfolding + | otherwise = unfoldingInfo info + where + info = idInfo id + +realIdUnfolding :: Id -> Unfolding +-- Expose the unfolding if there is one, including for loop breakers +realIdUnfolding id = unfoldingInfo (idInfo id) setIdUnfolding :: Id -> Unfolding -> Id setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id -#ifdef OLD_STRICTNESS - --------------------------------- - -- (OLD) DEMAND -idDemandInfo :: Id -> Demand.Demand -idDemandInfo id = demandInfo (idInfo id) - -setIdDemandInfo :: Id -> Demand.Demand -> Id -setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id -#endif +idDemandInfo_maybe :: Id -> Maybe Demand +idDemandInfo :: Id -> Demand -idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand -idNewDemandInfo :: Id -> NewDemand.Demand +idDemandInfo_maybe id = demandInfo (idInfo id) +idDemandInfo id = demandInfo (idInfo id) `orElse` topDmd -idNewDemandInfo_maybe id = newDemandInfo (idInfo id) -idNewDemandInfo id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd - -setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id -setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id +setIdDemandInfo :: Id -> Demand -> Id +setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` Just dmd) id --------------------------------- -- SPECIALISATION + +-- See Note [Specialisations and RULES in IdInfo] in IdInfo.lhs + idSpecialisation :: Id -> SpecInfo idSpecialisation id = specInfo (idInfo id) @@ -575,34 +525,21 @@ setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id --------------------------------- -- CAF INFO idCafInfo :: Id -> CafInfo -#ifdef OLD_STRICTNESS -idCafInfo id = case cgInfo (idInfo id) of - NoCgInfo -> pprPanic "idCafInfo" (ppr id) - info -> cgCafInfo info -#else idCafInfo id = cafInfo (idInfo id) -#endif setIdCafInfo :: Id -> CafInfo -> Id setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id --------------------------------- - -- CPR INFO -#ifdef OLD_STRICTNESS -idCprInfo :: Id -> CprInfo -idCprInfo id = cprInfo (idInfo id) - -setIdCprInfo :: Id -> CprInfo -> Id -setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id -#endif - - --------------------------------- -- Occcurrence INFO idOccInfo :: Id -> OccInfo idOccInfo id = occInfo (idInfo id) setIdOccInfo :: Id -> OccInfo -> Id setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id + +zapIdOccInfo :: Id -> Id +zapIdOccInfo b = b `setIdOccInfo` NoOccInfo \end{code} @@ -612,14 +549,26 @@ The inline pragma tells us to be very keen to inline this Id, but it's still OK not to if optimisation is switched off. \begin{code} -idInlinePragma :: Id -> InlinePragInfo +idInlinePragma :: Id -> InlinePragma idInlinePragma id = inlinePragInfo (idInfo id) -setInlinePragma :: Id -> InlinePragInfo -> Id +setInlinePragma :: Id -> InlinePragma -> Id setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id -modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id +modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id + +idInlineActivation :: Id -> Activation +idInlineActivation id = inlinePragmaActivation (idInlinePragma id) + +setInlineActivation :: Id -> Activation -> Id +setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act) + +idRuleMatchInfo :: Id -> RuleMatchInfo +idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id) + +isConLikeId :: Id -> Bool +isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id) \end{code} @@ -711,23 +660,47 @@ where g has interesting strictness information. Then if we float thus g' = /\a. rhs f = /\a. ...[g' a/g] -we *do not* want to lose the strictness information on g. Nor arity. +we *do not* want to lose g's + * strictness information + * arity + * inline pragma (though that is bit more debatable) It's simple to retain strictness and arity, but not so simple to retain - worker info - rules + * worker info + * rules so we simply discard those. Sooner or later this may bite us. This transfer is used in two places: FloatOut (long-distance let-floating) SimplUtils.abstractFloats (short-distance let-floating) +If we abstract wrt one or more *value* binders, we must modify the +arity and strictness info before transferring it. E.g. + f = \x. e +--> + g' = \y. \x. e + + substitute (g' y) for g +Notice that g' has an arity one more than the original g + \begin{code} -transferPolyIdInfo :: Id -> Id -> Id -transferPolyIdInfo old_id new_id +transferPolyIdInfo :: Id -- Original Id + -> [Var] -- Abstract wrt these variables + -> Id -- New Id + -> Id +transferPolyIdInfo old_id abstract_wrt new_id = modifyIdInfo transfer new_id where - old_info = idInfo old_id - transfer new_info = new_info `setNewStrictnessInfo` (newStrictnessInfo old_info) - `setArityInfo` (arityInfo old_info) + arity_increase = count isId abstract_wrt -- Arity increases by the + -- number of value binders + + old_info = idInfo old_id + old_arity = arityInfo old_info + old_inline_prag = inlinePragInfo old_info + new_arity = old_arity + arity_increase + old_strictness = strictnessInfo old_info + new_strictness = fmap (increaseStrictSigArity arity_increase) old_strictness + + transfer new_info = new_info `setStrictnessInfo` new_strictness + `setArityInfo` new_arity + `setInlinePragInfo` old_inline_prag \end{code}