- `setNewStrictnessInfo`,
- `setAllStrictnessInfo`,
- `setNewDemandInfo`
-#ifdef OLD_STRICTNESS
- , `setCprInfo`
- , `setDemandInfo`
- , `setStrictnessInfo`
-#endif
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{New strictness info}
-%* *
-%************************************************************************
-
-To be removed later
-
-\begin{code}
--- Set old and new strictness info
-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) = ftext (fsLit "Str:") <+> 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 */