-- Unfolding
unfoldingInfo, setUnfoldingInfo,
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
-- Old DemandInfo and StrictnessInfo
demandInfo, setDemandInfo,
strictnessInfo, setStrictnessInfo,
import NewDemand
import Outputable
import Util ( seqList, listLengthCmp )
+import Maybe ( isJust )
import List ( replicate )
-- infixl so you can say (id `set` a `set` b)
`setCafInfo`,
`setNewStrictnessInfo`,
`setAllStrictnessInfo`,
- `setNewDemandInfo`,
-#ifdef DEBUG
- `setCprInfo`,
- `setDemandInfo`,
- `setStrictnessInfo`
+ `setNewDemandInfo`
+#ifdef OLD_STRICTNESS
+ , `setCprInfo`
+ , `setDemandInfo`
+ , `setStrictnessInfo`
#endif
\end{code}
To be removed later
\begin{code}
-setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
+-- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
-- Set old and new strictness info
setAllStrictnessInfo info Nothing
- = info { newStrictnessInfo = Nothing,
-#ifdef DEBUG
- strictnessInfo = NoStrictnessInfo,
- cprInfo = NoCPRInfo,
+ = info { newStrictnessInfo = Nothing
+#ifdef OLD_STRICTNESS
+ , strictnessInfo = NoStrictnessInfo
+ , cprInfo = NoCPRInfo
#endif
- }
+ }
+
setAllStrictnessInfo info (Just sig)
- = info { newStrictnessInfo = Just sig,
-#ifdef DEBUG
- strictnessInfo = oldStrictnessFromNew sig,
- cprInfo = cprInfoFromNewStrictness sig,
+ = info { newStrictnessInfo = Just sig
+#ifdef OLD_STRICTNESS
+ , strictnessInfo = oldStrictnessFromNew sig
+ , cprInfo = cprInfoFromNewStrictness sig
#endif
- }
+ }
seqNewStrictnessInfo Nothing = ()
seqNewStrictnessInfo (Just ty) = seqStrictSig ty
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
where
oldDemand (Eval (Poly _)) = WwStrict
oldDemand (Call _) = WwStrict
-#endif /* DEBUG */
+#endif /* OLD_STRICTNESS */
+\end{code}
+
+
+\begin{code}
+seqNewDemandInfo Nothing = ()
+seqNewDemandInfo (Just dmd) = seqDemand dmd
\end{code}
arityInfo :: !ArityInfo, -- Its arity
specInfo :: CoreRules, -- Specialisations of this function which exist
tyGenInfo :: TyGenInfo, -- Restrictions on usage-generalisation of this Id
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
cprInfo :: CprInfo, -- Function always constructs a product result
demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded
strictnessInfo :: StrictnessInfo, -- Strictness properties
-- know whether whether this is the first visit,
-- so it can assign botSig. Other customers want
-- topSig. So Nothing is good.
- newDemandInfo :: Demand
+
+ newDemandInfo :: Maybe Demand -- Similarly we want to know if there's no
+ -- known demand yet, for when we are looking for
+ -- CPR info
}
seqIdInfo :: IdInfo -> ()
-- some unfoldings are not calculated at all
-- seqUnfolding (unfoldingInfo info) `seq`
- seqDemand (newDemandInfo info) `seq`
+ seqNewDemandInfo (newDemandInfo info) `seq`
seqNewStrictnessInfo (newStrictnessInfo info) `seq`
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
Demand.seqDemand (demandInfo info) `seq`
seqStrictnessInfo (strictnessInfo info) `seq`
seqCpr (cprInfo info) `seq`
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 DEBUG
+#ifdef OLD_STRICTNESS
setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
#endif
-- Try to avoid spack leaks by seq'ing
-- let x = (a,b) in h a b x
-- and now x is not demanded (I'm assuming h is lazy)
-- This really happens. The solution here is a bit ad hoc...
- = info { unfoldingInfo = uf, newDemandInfo = Top }
+ = info { unfoldingInfo = uf, newDemandInfo = Nothing }
| otherwise
-- We do *not* seq on the unfolding info, For some reason, doing so
-- actually increases residency significantly.
= info { unfoldingInfo = uf }
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
setDemandInfo info dd = info { demandInfo = dd }
setCprInfo info cp = info { cprInfo = cp }
#endif
= IdInfo {
cgInfo = noCgInfo,
arityInfo = unknownArity,
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
cprInfo = NoCPRInfo,
demandInfo = wwLazy,
strictnessInfo = NoStrictnessInfo,
lbvarInfo = NoLBVarInfo,
inlinePragInfo = AlwaysActive,
occInfo = NoOccInfo,
- newDemandInfo = topDmd,
+ newDemandInfo = Nothing,
newStrictnessInfo = Nothing
}
downstream, by the code generator.
\begin{code}
-#ifndef DEBUG
+#ifndef OLD_STRICTNESS
newtype CgInfo = CgInfo CafInfo -- We are back to only having CafRefs in CgInfo
noCgInfo = panic "NoCgInfo!"
#else
also CPRs.
\begin{code}
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
data CprInfo
= NoCPRInfo
| ReturnsCPR -- Yes, this function returns a constructed product
-- property of the definition, but a property of the context.
pprLBVarInfo NoLBVarInfo = empty
pprLBVarInfo (LBVarInfo u) | u `eqUsage` usOnce
- = getPprStyle $ \ sty ->
- if ifaceStyle sty
- then empty
- else ptext SLIT("OneShot")
+ = ptext SLIT("OneShot")
| otherwise
= empty
\begin{code}
zapLamInfo :: IdInfo -> Maybe IdInfo
zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
- | is_safe_occ && not (isStrictDmd demand)
+ | is_safe_occ occ && is_safe_dmd demand
= Nothing
| otherwise
- = Just (info {occInfo = safe_occ,
- newDemandInfo = Top})
+ = Just (info {occInfo = safe_occ, newDemandInfo = 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
- is_safe_occ = case occ of
- OneOcc in_lam once -> in_lam
- other -> True
+ is_safe_occ (OneOcc in_lam once) = in_lam
+ is_safe_occ other = True
safe_occ = case occ of
OneOcc _ once -> OneOcc insideLam once
other -> occ
+
+ is_safe_dmd Nothing = True
+ is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
\end{code}
\begin{code}
zapDemandInfo :: IdInfo -> Maybe IdInfo
-zapDemandInfo info@(IdInfo {newDemandInfo = demand})
- | not (isStrictDmd demand) = Nothing
- | otherwise = Just (info {newDemandInfo = Top})
+zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
+ | isJust dmd = Just (info {newDemandInfo = Nothing})
+ | otherwise = Nothing
\end{code}
-> IdInfo -- f (the exported one)
-> IdInfo -- New info for f
copyIdInfo f_local f = f { newStrictnessInfo = newStrictnessInfo f_local,
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
strictnessInfo = strictnessInfo f_local,
cprInfo = cprInfo f_local,
#endif
projects / ghc-hetmet.git / blobdiff