arityInfo, setArityInfo, ppArityInfo,
-- ** Demand and strictness Info
- newStrictnessInfo, setNewStrictnessInfo,
- newDemandInfo, setNewDemandInfo, pprNewStrictness,
- setAllStrictnessInfo,
-
-#ifdef OLD_STRICTNESS
- -- ** Old strictness Info
- StrictnessInfo(..),
- mkStrictnessInfo, noStrictnessInfo,
- ppStrictnessInfo, isBottomingStrictness,
- strictnessInfo, setStrictnessInfo,
-
- oldStrictnessFromNew, newStrictnessFromOld,
-
- -- ** Old demand Info
- demandInfo, setDemandInfo,
- oldDemand, newDemand,
-
- -- ** Old Constructed Product Result Info
- CprInfo(..),
- cprInfo, setCprInfo, ppCprInfo, noCprInfo,
- cprInfoFromNewStrictness,
-#endif
+ strictnessInfo, setStrictnessInfo,
+ demandInfo, setDemandInfo, pprStrictness,
-- ** Unfolding Info
unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
import DataCon
import TyCon
import ForeignCall
-import NewDemand
+import Demand
import Outputable
import Module
import FastString
import Data.Maybe
-#ifdef OLD_STRICTNESS
-import Demand
-import qualified Demand
-import Util
-import Data.List
-#endif
-
-- infixl so you can say (id `set` a `set` b)
infixl 1 `setSpecInfo`,
`setArityInfo`,
`setLBVarInfo`,
`setOccInfo`,
`setCafInfo`,
- `setNewStrictnessInfo`,
- `setAllStrictnessInfo`,
- `setNewDemandInfo`
-#ifdef OLD_STRICTNESS
- , `setCprInfo`
- , `setDemandInfo`
- , `setStrictnessInfo`
-#endif
+ `setStrictnessInfo`,
+ `setDemandInfo`
\end{code}
%************************************************************************
%* *
-\subsection{New strictness info}
-%* *
-%************************************************************************
-
-To be removed later
-
-\begin{code}
--- | Set old and new strictness information together
-setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
-setAllStrictnessInfo info Nothing
- = info { newStrictnessInfo = Nothing
-#ifdef OLD_STRICTNESS
- , strictnessInfo = NoStrictnessInfo
- , cprInfo = NoCPRInfo
-#endif
- }
-
-setAllStrictnessInfo info (Just sig)
- = info { newStrictnessInfo = Just sig
-#ifdef OLD_STRICTNESS
- , strictnessInfo = oldStrictnessFromNew sig
- , cprInfo = cprInfoFromNewStrictness sig
-#endif
- }
-
-seqNewStrictnessInfo :: Maybe StrictSig -> ()
-seqNewStrictnessInfo Nothing = ()
-seqNewStrictnessInfo (Just ty) = seqStrictSig ty
-
-pprNewStrictness :: Maybe StrictSig -> SDoc
-pprNewStrictness Nothing = empty
-pprNewStrictness (Just sig) = ppr sig
-
-#ifdef OLD_STRICTNESS
-oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
-oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
- where
- (dmds, res_info) = splitStrictSig sig
-
-cprInfoFromNewStrictness :: StrictSig -> CprInfo
-cprInfoFromNewStrictness sig = case strictSigResInfo sig of
- RetCPR -> ReturnsCPR
- other -> NoCPRInfo
-
-newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig
-newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr
- | listLengthCmp ds arity /= GT -- length ds <= arity
- -- Sometimes the old strictness analyser has more
- -- demands than the arity justifies
- = mk_strict_sig name arity $
- mkTopDmdType (map newDemand ds) (newRes res cpr)
-
-newStrictnessFromOld name arity other cpr
- = -- Either no strictness info, or arity is too small
- -- In either case we can't say anything useful
- mk_strict_sig name arity $
- mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
-
-mk_strict_sig name arity dmd_ty
- = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) )
- mkStrictSig dmd_ty
-
-newRes True _ = BotRes
-newRes False ReturnsCPR = retCPR
-newRes False NoCPRInfo = TopRes
-
-newDemand :: Demand.Demand -> NewDemand.Demand
-newDemand (WwLazy True) = Abs
-newDemand (WwLazy False) = lazyDmd
-newDemand WwStrict = evalDmd
-newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds))
-newDemand WwPrim = lazyDmd
-newDemand WwEnum = evalDmd
-
-oldDemand :: NewDemand.Demand -> Demand.Demand
-oldDemand Abs = WwLazy True
-oldDemand Top = WwLazy False
-oldDemand Bot = WwStrict
-oldDemand (Box Bot) = WwStrict
-oldDemand (Box Abs) = WwLazy False
-oldDemand (Box (Eval _)) = WwStrict -- Pass box only
-oldDemand (Defer d) = WwLazy False
-oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
-oldDemand (Eval (Poly _)) = WwStrict
-oldDemand (Call _) = WwStrict
-
-#endif /* OLD_STRICTNESS */
-\end{code}
-
-
-\begin{code}
-seqNewDemandInfo :: Maybe Demand -> ()
-seqNewDemandInfo Nothing = ()
-seqNewDemandInfo (Just dmd) = seqDemand dmd
-\end{code}
-
-
-%************************************************************************
-%* *
IdDetails
%* *
%************************************************************************
arityInfo :: !ArityInfo, -- ^ 'Id' arity
specInfo :: SpecInfo, -- ^ Specialisations of the 'Id's function which exist
-- See Note [Specialisations and RULES in IdInfo]
-#ifdef OLD_STRICTNESS
- cprInfo :: CprInfo, -- ^ If the 'Id's function always constructs a product result
- demandInfo :: Demand.Demand, -- ^ Whether or not the 'Id' is definitely demanded
- strictnessInfo :: StrictnessInfo, -- ^ 'Id' strictness properties
-#endif
unfoldingInfo :: Unfolding, -- ^ The 'Id's unfolding
cafInfo :: CafInfo, -- ^ 'Id' CAF info
lbvarInfo :: LBVarInfo, -- ^ Info about a lambda-bound variable, if the 'Id' is one
inlinePragInfo :: InlinePragma, -- ^ Any inline pragma atached to the 'Id'
occInfo :: OccInfo, -- ^ How the 'Id' occurs in the program
- newStrictnessInfo :: Maybe StrictSig, -- ^ Id strictness information. Reason for Maybe:
+ strictnessInfo :: Maybe StrictSig, -- ^ Id strictness information. Reason for Maybe:
-- the DmdAnal phase needs to know whether
-- this is the first visit, so it can assign botSig.
-- Other customers want topSig. So @Nothing@ is good.
- newDemandInfo :: Maybe Demand -- ^ Id demand information. Similarly we want to know
+ demandInfo :: Maybe Demand -- ^ Id demand information. Similarly we want to know
-- if there's no known demand yet, for when we are looking
-- for CPR info
}
-- some unfoldings are not calculated at all
-- seqUnfolding (unfoldingInfo info) `seq`
- seqNewDemandInfo (newDemandInfo info) `seq`
- seqNewStrictnessInfo (newStrictnessInfo info) `seq`
-
-#ifdef OLD_STRICTNESS
- Demand.seqDemand (demandInfo info) `seq`
- seqStrictnessInfo (strictnessInfo info) `seq`
- seqCpr (cprInfo info) `seq`
-#endif
+ seqDemandInfo (demandInfo info) `seq`
+ seqStrictnessInfo (strictnessInfo info) `seq`
seqCaf (cafInfo info) `seq`
seqLBVar (lbvarInfo info) `seq`
seqOccInfo (occInfo info)
+
+seqStrictnessInfo :: Maybe StrictSig -> ()
+seqStrictnessInfo Nothing = ()
+seqStrictnessInfo (Just ty) = seqStrictSig ty
+
+seqDemandInfo :: Maybe Demand -> ()
+seqDemandInfo Nothing = ()
+seqDemandInfo (Just dmd) = seqDemand dmd
\end{code}
Setters
setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
setOccInfo :: IdInfo -> OccInfo -> IdInfo
setOccInfo info oc = oc `seq` info { occInfo = oc }
-#ifdef OLD_STRICTNESS
-setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
-#endif
-- Try to avoid spack leaks by seq'ing
setUnfoldingInfoLazily :: IdInfo -> Unfolding -> IdInfo
-- actually increases residency significantly.
= info { unfoldingInfo = uf }
-#ifdef OLD_STRICTNESS
-setDemandInfo info dd = info { demandInfo = dd }
-setCprInfo info cp = info { cprInfo = cp }
-#endif
-
setArityInfo :: IdInfo -> ArityInfo -> IdInfo
setArityInfo info ar = info { arityInfo = ar }
setCafInfo :: IdInfo -> CafInfo -> IdInfo
setLBVarInfo :: IdInfo -> LBVarInfo -> IdInfo
setLBVarInfo info lb = {-lb `seq`-} info { lbvarInfo = lb }
-setNewDemandInfo :: IdInfo -> Maybe Demand -> IdInfo
-setNewDemandInfo info dd = dd `seq` info { newDemandInfo = dd }
-setNewStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
-setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
+setDemandInfo :: IdInfo -> Maybe Demand -> IdInfo
+setDemandInfo info dd = dd `seq` info { demandInfo = dd }
+
+setStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
+setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd }
\end{code}
= IdInfo {
cafInfo = vanillaCafInfo,
arityInfo = unknownArity,
-#ifdef OLD_STRICTNESS
- cprInfo = NoCPRInfo,
- demandInfo = wwLazy,
- strictnessInfo = NoStrictnessInfo,
-#endif
specInfo = emptySpecInfo,
unfoldingInfo = noUnfolding,
lbvarInfo = NoLBVarInfo,
inlinePragInfo = defaultInlinePragma,
occInfo = NoOccInfo,
- newDemandInfo = Nothing,
- newStrictnessInfo = Nothing
+ demandInfo = Nothing,
+ strictnessInfo = Nothing
}
-- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
%************************************************************************
%* *
+ Strictness
+%* *
+%************************************************************************
+
+\begin{code}
+pprStrictness :: Maybe StrictSig -> SDoc
+pprStrictness Nothing = empty
+pprStrictness (Just sig) = ppr sig
+\end{code}
+
+
+%************************************************************************
+%* *
SpecInfo
%* *
%************************************************************************
%************************************************************************
%* *
-\subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
-%* *
-%************************************************************************
-
-\begin{code}
-#ifdef OLD_STRICTNESS
--- | If the @Id@ is a function then it may have Constructed Product Result
--- (CPR) info. A CPR analysis phase detects whether:
---
--- 1. The function's return value has a product type, i.e. an algebraic type
--- with a single constructor. Examples of such types are tuples and boxed
--- primitive values.
---
--- 2. The function always 'constructs' the value that it is returning. It
--- must do this on every path through, and it's OK if it calls another
--- function which constructs the result.
---
--- If this is the case then we store a template which tells us the
--- function has the CPR property and which components of the result are
--- also CPRs.
-data CprInfo
- = NoCPRInfo -- ^ No, this function does not return a constructed product
- | ReturnsCPR -- ^ Yes, this function returns a constructed product
-
- -- Implicitly, this means "after the function has been applied
- -- to all its arguments", so the worker\/wrapper builder in
- -- WwLib.mkWWcpr checks that that it is indeed saturated before
- -- making use of the CPR info
-
- -- We used to keep nested info about sub-components, but
- -- we never used it so I threw it away
-
--- | It's always safe to assume that an 'Id' does not have the CPR property
-noCprInfo :: CprInt
-noCprInfo = NoCPRInfo
-
-seqCpr :: CprInfo -> ()
-seqCpr ReturnsCPR = ()
-seqCpr NoCPRInfo = ()
-
-ppCprInfo NoCPRInfo = empty
-ppCprInfo ReturnsCPR = ptext (sLit "__M")
-
-instance Outputable CprInfo where
- ppr = ppCprInfo
-
-instance Show CprInfo where
- showsPrec p c = showsPrecSDoc p (ppr c)
-#endif
-\end{code}
-
-%************************************************************************
-%* *
\subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
%* *
%************************************************************************
--
-- > (\x1. \x2. e) arg1
zapLamInfo :: IdInfo -> Maybe IdInfo
-zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
+zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
| is_safe_occ occ && is_safe_dmd demand
= Nothing
| otherwise
- = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
+ = Just (info {occInfo = safe_occ, demandInfo = Nothing})
where
-- The "unsafe" occ info is the ones that say I'm not in a lambda
-- because that might not be true for an unsaturated lambda
\begin{code}
-- | Remove demand info on the 'IdInfo' if it is present, otherwise return @Nothing@
zapDemandInfo :: IdInfo -> Maybe IdInfo
-zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
- | isJust dmd = Just (info {newDemandInfo = Nothing})
+zapDemandInfo info@(IdInfo {demandInfo = dmd})
+ | isJust dmd = Just (info {demandInfo = Nothing})
| otherwise = Nothing
\end{code}
projects / ghc-hetmet.git / blobdiff