%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 19921998
%
\section[Demand]{@Demand@: the amount of demand on a value}
\begin{code}
#ifndef OLD_STRICTNESS
module Demand () where
#else
module Demand(
Demand(..),
wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum,
isStrict, isLazy, isPrim,
pprDemands, seqDemand, seqDemands,
StrictnessInfo(..),
mkStrictnessInfo,
noStrictnessInfo,
ppStrictnessInfo, seqStrictnessInfo,
isBottomingStrictness, appIsBottom,
) where
#include "HsVersions.h"
import Outputable
import Util
\end{code}
%************************************************************************
%* *
\subsection{The @Demand@ data type}
%* *
%************************************************************************
\begin{code}
data Demand
= WwLazy
MaybeAbsent
| WwStrict
| WwUnpack
Bool
[Demand]
| WwPrim
| WwEnum
deriving( Eq )
type MaybeAbsent = Bool
wwLazy, wwStrict, wwPrim, wwEnum :: Demand
wwUnpack :: [Demand] -> Demand
wwLazy = WwLazy False
wwStrict = WwStrict
wwUnpack xs = WwUnpack False xs
wwPrim = WwPrim
wwEnum = WwEnum
seqDemand :: Demand -> ()
seqDemand (WwLazy a) = a `seq` ()
seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
seqDemand _ = ()
seqDemands :: [Demand] -> ()
seqDemands [] = ()
seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
\end{code}
%************************************************************************
%* *
\subsection{Functions over @Demand@}
%* *
%************************************************************************
\begin{code}
isLazy :: Demand -> Bool
isLazy (WwLazy _) = True
isLazy _ = False
isStrict :: Demand -> Bool
isStrict d = not (isLazy d)
isPrim :: Demand -> Bool
isPrim WwPrim = True
isPrim _ = False
\end{code}
%************************************************************************
%* *
\subsection{Instances}
%* *
%************************************************************************
\begin{code}
pprDemands :: [Demand] -> Bool -> SDoc
pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
where
pp_bot | bot = ptext (sLit "B")
| otherwise = empty
pprDemand :: Demand -> SDoc
pprDemand (WwLazy False) = char 'L'
pprDemand (WwLazy True) = char 'A'
pprDemand WwStrict = char 'S'
pprDemand WwPrim = char 'P'
pprDemand WwEnum = char 'E'
pprDemand (WwUnpack wu args) = char ch <> parens (hcat (map pprDemand args))
where
ch = if wu then 'U' else 'u'
instance Outputable Demand where
ppr (WwLazy False) = empty
ppr other_demand = ptext (sLit "__D") <+> pprDemand other_demand
instance Show Demand where
showsPrec p d = showsPrecSDoc p (ppr d)
\end{code}
%************************************************************************
%* *
\subsection[strictnessIdInfo]{Strictness info about an @Id@}
%* *
%************************************************************************
We specify the strictness of a function by giving information about
each of the ``wrapper's'' arguments (see the description about
worker/wrapperstyle transformations in the PJ/Launchbury paper on
unboxed types).
The list of @Demands@ specifies: (a)~the strictness properties of a
function's arguments; and (b)~the type signature of that worker (if it
exists); i.e. its calling convention.
Note that the existence of a worker function is now denoted by the Id's
workerInfo field.
\begin{code}
data StrictnessInfo
= NoStrictnessInfo
| StrictnessInfo [Demand]
Bool
deriving( Eq )
seqStrictnessInfo :: StrictnessInfo -> ()
seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
seqStrictnessInfo _ = ()
\end{code}
\begin{code}
mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
mkStrictnessInfo (xs, is_bot)
| all totally_boring xs && not is_bot = NoStrictnessInfo
| otherwise = StrictnessInfo xs is_bot
where
totally_boring (WwLazy False) = True
totally_boring _ = False
noStrictnessInfo :: StrictnessInfo
noStrictnessInfo = NoStrictnessInfo
isBottomingStrictness :: StrictnessInfo -> Bool
isBottomingStrictness (StrictnessInfo _ bot) = bot
isBottomingStrictness NoStrictnessInfo = False
appIsBottom :: StrictnessInfo -> Int -> Bool
appIsBottom (StrictnessInfo ds bot) n = bot && (listLengthCmp ds n /=GT)
appIsBottom NoStrictnessInfo _ = False
ppStrictnessInfo :: StrictnessInfo -> SDoc
ppStrictnessInfo NoStrictnessInfo = empty
ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
\end{code}
\begin{code}
#endif /* OLD_STRICTNESS */
\end{code}