\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,
ppStrictnessInfo, seqStrictnessInfo,
isBottomingStrictness, appIsBottom,
- StrictnessMark(..), isMarkedUnboxed, isMarkedStrict
) where
#include "HsVersions.h"
-import BasicTypes ( NewOrData(..) )
import Outputable
+import Util ( listLengthCmp )
\end{code}
= WwLazy -- Argument is lazy as far as we know
MaybeAbsent -- (does not imply worker's existence [etc]).
-- If MaybeAbsent == True, then it is
- -- *definitely* lazy. (NB: Absence implies
+ -- *definitely* lazy. (NB: Absence implies
-- a worker...)
| WwStrict -- Argument is strict but that's all we know
-- 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 = ASSERT( isStrict x) -- Invariant
- 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
- -- Even a demand of (WwUnpack NewType _ _) is strict
- -- We don't create such a thing unless the demand inside is strict
isLazy (WwLazy _) = True
isLazy _ = False
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
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 [pprDemands wrapper_args bot]
\end{code}
-
-%************************************************************************
-%* *
-\subsection{Strictness indication}
-%* *
-%************************************************************************
-
-The strictness annotations on types in data type declarations
-e.g. data T = MkT !Int !(Bool,Bool)
-
\begin{code}
-data StrictnessMark
- = MarkedUserStrict -- "!" in a source decl
- | MarkedStrict -- "!" in an interface decl: strict but not unboxed
- | MarkedUnboxed -- "!!" in an interface decl: unboxed
- | NotMarkedStrict -- No annotation at all
- deriving( Eq )
-
-isMarkedUnboxed MarkedUnboxed = True
-isMarkedUnboxed other = False
-
-isMarkedStrict NotMarkedStrict = False
-isMarkedStrict other = True -- All others are strict
-
-instance Outputable StrictnessMark where
- ppr MarkedUserStrict = ptext SLIT("!u")
- ppr MarkedStrict = ptext SLIT("!")
- ppr MarkedUnboxed = ptext SLIT("! !")
- ppr NotMarkedStrict = empty
+#endif /* OLD_STRICTNESS */
\end{code}
-
-