X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FIdInfo.lhs;h=0a173d9831243bcfead3837d38b8c55ccea0e86a;hp=9b74a487f0e663191ceac67a15013808186a80b6;hb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;hpb=c8ef1c4a3da7b86516866d8e30e81ef4f9a06041 diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs index 9b74a48..0a173d9 100644 --- a/compiler/basicTypes/IdInfo.lhs +++ b/compiler/basicTypes/IdInfo.lhs @@ -26,28 +26,8 @@ module IdInfo ( 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, @@ -94,20 +74,13 @@ import BasicTypes 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`, @@ -116,117 +89,12 @@ infixl 1 `setSpecInfo`, `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 %* * %************************************************************************ @@ -311,23 +179,18 @@ data IdInfo 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 } @@ -346,18 +209,20 @@ megaSeqIdInfo 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 @@ -369,9 +234,6 @@ setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo 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 @@ -385,11 +247,6 @@ setUnfoldingInfo info uf -- 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 @@ -398,10 +255,11 @@ setCafInfo info caf = info { cafInfo = caf } 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} @@ -412,18 +270,13 @@ vanillaIdInfo = 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 @@ -485,6 +338,19 @@ type InlinePragInfo = InlinePragma %************************************************************************ %* * + Strictness +%* * +%************************************************************************ + +\begin{code} +pprStrictness :: Maybe StrictSig -> SDoc +pprStrictness Nothing = empty +pprStrictness (Just sig) = ppr sig +\end{code} + + +%************************************************************************ +%* * SpecInfo %* * %************************************************************************ @@ -586,59 +452,6 @@ ppCafInfo MayHaveCafRefs = empty %************************************************************************ %* * -\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@} %* * %************************************************************************ @@ -690,11 +503,11 @@ instance Show LBVarInfo where -- -- > (\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 @@ -712,8 +525,8 @@ zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand}) \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}