-addInlinePragma :: Id -> Id
-addInlinePragma id@(Id {idInfo = info})
- = id {idInfo = setInlinePragInfo IWantToBeINLINEd info}
-
-nukeNoInlinePragma :: Id -> Id
-nukeNoInlinePragma id@(Id {idInfo = info})
- = case inlinePragInfo info of
- IMustNotBeINLINEd -> id {idInfo = setInlinePragInfo NoPragmaInfo info}
- other -> id
-
-addNoInlinePragma :: Id -> Id
-addNoInlinePragma id@(Id {idInfo = info})
- = id {idInfo = IMustNotBeINLINEd `setInlinePragInfo` info}
-
-mustInlineInfo = IMustBeINLINEd `setInlinePragInfo` noIdInfo
-wantToInlineInfo = IWantToBeINLINEd `setInlinePragInfo` noIdInfo
-\end{code}
-
-
-
-%************************************************************************
-%* *
-\subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
-%* *
-%************************************************************************
-
-\begin{code}
-getIdDemandInfo :: Id -> DemandInfo
-getIdDemandInfo id = demandInfo (idInfo id)
-
-addIdDemandInfo :: Id -> DemandInfo -> Id
-addIdDemandInfo id@(Id {idInfo = info}) demand_info
- = id {idInfo = demand_info `setDemandInfo` info}
-\end{code}p
-
-\begin{code}
-getIdUpdateInfo :: Id -> UpdateInfo
-getIdUpdateInfo id = updateInfo (idInfo id)
-
-addIdUpdateInfo :: Id -> UpdateInfo -> Id
-addIdUpdateInfo id@(Id {idInfo = info}) upd_info
- = id {idInfo = upd_info `setUpdateInfo` info}
-\end{code}
-
-\begin{code}
-getIdSpecialisation :: Id -> IdSpecEnv
-getIdSpecialisation id = specInfo (idInfo id)
-
-setIdSpecialisation :: Id -> IdSpecEnv -> Id
-setIdSpecialisation id@(Id {idInfo = info}) spec_info
- = id {idInfo = spec_info `setSpecInfo` info}
-\end{code}
-
-\begin{code}
-getIdStrictness :: Id -> StrictnessInfo
-getIdStrictness id = strictnessInfo (idInfo id)
-
-addIdStrictness :: Id -> StrictnessInfo -> Id
-addIdStrictness id@(Id {idInfo = info}) strict_info
- = id {idInfo = strict_info `setStrictnessInfo` info}
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Id-comparison]{Comparison functions for @Id@s}
-%* *
-%************************************************************************
-
-Comparison: equality and ordering---this stuff gets {\em hammered}.
-
-\begin{code}
-cmpId (Id {idUnique = u1}) (Id {idUnique = u2}) = compare u1 u2
-\end{code}
-
-\begin{code}
-instance Eq (GenId ty) where
- a == b = case (a `compare` b) of { EQ -> True; _ -> False }
- a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
-
-instance Ord (GenId ty) where
- a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
- a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
- a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
- a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
- compare a b = cmpId a b
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Id-other-instances]{Other instance declarations for @Id@s}
-%* *
-%************************************************************************
-
-\begin{code}
-instance Outputable ty => Outputable (GenId ty) where
- ppr id = pprId id
-
-showId :: Id -> String
-showId id = showSDoc (pprId id)
-\end{code}
-
-Default printing code (not used for interfaces):
-\begin{code}
-pprId :: Outputable ty => GenId ty -> SDoc
-
-pprId Id {idUnique = u, idName = n, idInfo = info}
- = hcat [ppr n, pp_prags]
- where
- pp_prags sty
- | opt_PprStyle_All && not (codeStyle sty)
- = (case inlinePragInfo info of
- IMustNotBeINLINEd -> text "{n}"
- IWantToBeINLINEd -> text "{i}"
- IMustBeINLINEd -> text "{I}"
- other -> empty) sty
-
- | otherwise
- = empty sty
-
-\end{code}
-
-\begin{code}
-instance Uniquable (GenId ty) where
- uniqueOf = idUnique
-
-instance NamedThing (GenId ty) where
- getName = idName
-\end{code}
-
-Note: The code generator doesn't carry a @UniqueSupply@, so it uses
-the @Uniques@ out of local @Ids@ given to it.
-
-%************************************************************************
-%* *
-\subsection{@IdEnv@s and @IdSet@s}
-%* *
-%************************************************************************
-
-\begin{code}
-type IdEnv elt = UniqFM elt
-
-nullIdEnv :: IdEnv a
-
-mkIdEnv :: [(GenId ty, a)] -> IdEnv a
-unitIdEnv :: GenId ty -> a -> IdEnv a
-addOneToIdEnv :: IdEnv a -> GenId ty -> a -> IdEnv a
-growIdEnv :: IdEnv a -> IdEnv a -> IdEnv a
-growIdEnvList :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
-
-delManyFromIdEnv :: IdEnv a -> [GenId ty] -> IdEnv a
-delOneFromIdEnv :: IdEnv a -> GenId ty -> IdEnv a
-combineIdEnvs :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
-mapIdEnv :: (a -> b) -> IdEnv a -> IdEnv b
-modifyIdEnv :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
-rngIdEnv :: IdEnv a -> [a]
-
-isNullIdEnv :: IdEnv a -> Bool
-lookupIdEnv :: IdEnv a -> GenId ty -> Maybe a
-lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
-elemIdEnv :: Id -> IdEnv a -> Bool
-\end{code}
-
-\begin{code}
-elemIdEnv = elemUFM
-addOneToIdEnv = addToUFM
-combineIdEnvs = plusUFM_C
-delManyFromIdEnv = delListFromUFM
-delOneFromIdEnv = delFromUFM
-growIdEnv = plusUFM
-lookupIdEnv = lookupUFM
-mapIdEnv = mapUFM
-mkIdEnv = listToUFM
-nullIdEnv = emptyUFM
-rngIdEnv = eltsUFM
-unitIdEnv = unitUFM
-isNullIdEnv = isNullUFM
-
-growIdEnvList env pairs = plusUFM env (listToUFM pairs)
-lookupNoFailIdEnv env id = case (lookupIdEnv env id) of { Just xx -> xx }
-
-lookupIdSubst :: IdEnv Id -> Id -> Id
-lookupIdSubst env id = case lookupIdEnv env id of
- Just id' -> id' -- Return original if
- Nothing -> id -- it isn't in subst
-
--- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
--- modify function, and put it back.
-
-modifyIdEnv mangle_fn env key
- = case (lookupIdEnv env key) of
- Nothing -> env
- Just xx -> addOneToIdEnv env key (mangle_fn xx)
-
-modifyIdEnv_Directly mangle_fn env key
- = case (lookupUFM_Directly env key) of
- Nothing -> env
- Just xx -> addToUFM_Directly env key (mangle_fn xx)
-\end{code}
-
-\begin{code}
-type GenIdSet ty = UniqSet (GenId ty)
-type IdSet = UniqSet (GenId Type)
-
-emptyIdSet :: GenIdSet ty
-intersectIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
-unionIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
-unionManyIdSets :: [GenIdSet ty] -> GenIdSet ty
-idSetToList :: GenIdSet ty -> [GenId ty]
-unitIdSet :: GenId ty -> GenIdSet ty
-addOneToIdSet :: GenIdSet ty -> GenId ty -> GenIdSet ty
-elementOfIdSet :: GenId ty -> GenIdSet ty -> Bool
-minusIdSet :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
-isEmptyIdSet :: GenIdSet ty -> Bool
-mkIdSet :: [GenId ty] -> GenIdSet ty
-
-emptyIdSet = emptyUniqSet
-unitIdSet = unitUniqSet
-addOneToIdSet = addOneToUniqSet
-intersectIdSets = intersectUniqSets
-unionIdSets = unionUniqSets
-unionManyIdSets = unionManyUniqSets
-idSetToList = uniqSetToList
-elementOfIdSet = elementOfUniqSet
-minusIdSet = minusUniqSet
-isEmptyIdSet = isEmptyUniqSet
-mkIdSet = mkUniqSet
projects / ghc-hetmet.git / blobdiff