\section[Demand]{@Demand@: the amount of demand on a value}
\begin{code}
+#ifndef OLD_STRICTNESS
+module Demand () where
+#else
+
module Demand(
Demand(..),
- wwLazy, wwStrict, wwUnpackData, wwUnpackNew, wwPrim, wwEnum,
+ wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum,
isStrict, isLazy, isPrim,
pprDemands, seqDemand, seqDemands,
noStrictnessInfo,
ppStrictnessInfo, seqStrictnessInfo,
isBottomingStrictness, appIsBottom,
+
) where
#include "HsVersions.h"
-import BasicTypes ( NewOrData(..) )
import Outputable
+import Util ( listLengthCmp )
\end{code}
-- calling-convention magic)
| WwUnpack -- Argument is strict & a single-constructor type
- NewOrData
Bool -- True <=> wrapper unpacks it; False <=> doesn't
[Demand] -- Its constituent parts (whose StrictInfos
-- are in the list) should be passed
-- versions that don't worry about Absence:
wwLazy = WwLazy False
wwStrict = WwStrict
-wwUnpackData xs = WwUnpack DataType False xs
-wwUnpackNew x = WwUnpack NewType False [x]
+wwUnpack xs = WwUnpack False xs
wwPrim = WwPrim
wwEnum = WwEnum
seqDemand :: Demand -> ()
-seqDemand (WwLazy a) = a `seq` ()
-seqDemand (WwUnpack nd b ds) = nd `seq` b `seq` seqDemands ds
-seqDemand other = ()
+seqDemand (WwLazy a) = a `seq` ()
+seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
+seqDemand other = ()
seqDemands [] = ()
seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
%************************************************************************
\begin{code}
+isLazy :: Demand -> Bool
+isLazy (WwLazy _) = True
+isLazy _ = False
+
isStrict :: Demand -> Bool
-isStrict (WwUnpack NewType _ ds) = isStrict (head ds)
-isStrict (WwUnpack other _ _) = True
-isStrict WwStrict = True
-isStrict WwEnum = True
-isStrict WwPrim = True
-isStrict _ = False
+isStrict d = not (isLazy d)
isPrim :: Demand -> Bool
isPrim WwPrim = True
isPrim other = False
\end{code}
-\begin{code}
-isLazy :: Demand -> Bool
-isLazy (WwLazy False) = True -- NB "Absent" args do *not* count!
-isLazy _ = False -- (as they imply a worker)
-\end{code}
-
%************************************************************************
%* *
pprDemand WwStrict = char 'S'
pprDemand WwPrim = char 'P'
pprDemand WwEnum = char 'E'
-pprDemand (WwUnpack nd wu args) = char ch <> parens (hcat (map pprDemand args))
+pprDemand (WwUnpack wu args) = char ch <> parens (hcat (map pprDemand args))
where
- ch = case nd of
- DataType | wu -> 'U'
- | otherwise -> 'u'
- NewType | wu -> 'N'
- | otherwise -> 'n'
+ ch = if wu then 'U' else 'u'
instance Outputable Demand where
ppr (WwLazy False) = empty
-- BUT NB: f = \x y. error "urk"
-- will have info SI [SS] True
-- but still (f) and (f 2) are not bot; only (f 3 2) is bot
+ deriving( Eq )
-- NOTA BENE: if the arg demands are, say, [S,L], this means that
-- (f bot) is not necy bot, only (f bot x) is bot
mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
mkStrictnessInfo (xs, is_bot)
- | all isLazy xs && not is_bot = NoStrictnessInfo -- Uninteresting
- | otherwise = StrictnessInfo xs is_bot
+ | all totally_boring xs && not is_bot = NoStrictnessInfo -- Uninteresting
+ | otherwise = StrictnessInfo xs is_bot
+ where
+ totally_boring (WwLazy False) = True
+ totally_boring other = False
noStrictnessInfo = NoStrictnessInfo
isBottomingStrictness NoStrictnessInfo = False
-- appIsBottom returns true if an application to n args would diverge
-appIsBottom (StrictnessInfo ds bot) n = bot && (n >= length ds)
+appIsBottom (StrictnessInfo ds bot) n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
appIsBottom NoStrictnessInfo n = False
-ppStrictnessInfo NoStrictnessInfo = empty
-ppStrictnessInfo (StrictnessInfo wrapper_args bot)
- = hsep [ptext SLIT("__S"), pprDemands wrapper_args bot]
+ppStrictnessInfo NoStrictnessInfo = empty
+ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
\end{code}
+\begin{code}
+#endif /* OLD_STRICTNESS */
+\end{code}