2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Demand]{@Demand@: the amount of demand on a value}
14 wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum,
15 isStrict, isLazy, isPrim,
17 pprDemands, seqDemand, seqDemands,
22 ppStrictnessInfo, seqStrictnessInfo,
23 isBottomingStrictness, appIsBottom,
27 #include "HsVersions.h"
30 import Util ( listLengthCmp )
34 %************************************************************************
36 \subsection{The @Demand@ data type}
38 %************************************************************************
42 = WwLazy -- Argument is lazy as far as we know
43 MaybeAbsent -- (does not imply worker's existence [etc]).
44 -- If MaybeAbsent == True, then it is
45 -- *definitely* lazy. (NB: Absence implies
48 | WwStrict -- Argument is strict but that's all we know
49 -- (does not imply worker's existence or any
50 -- calling-convention magic)
52 | WwUnpack -- Argument is strict & a single-constructor type
53 Bool -- True <=> wrapper unpacks it; False <=> doesn't
54 [Demand] -- Its constituent parts (whose StrictInfos
55 -- are in the list) should be passed
56 -- as arguments to the worker.
58 | WwPrim -- Argument is of primitive type, therefore
59 -- strict; doesn't imply existence of a worker;
60 -- argument should be passed as is to worker.
62 | WwEnum -- Argument is strict & an enumeration type;
63 -- an Int# representing the tag (start counting
64 -- at zero) should be passed to the worker.
67 type MaybeAbsent = Bool -- True <=> not even used
69 -- versions that don't worry about Absence:
72 wwUnpack xs = WwUnpack False xs
76 seqDemand :: Demand -> ()
77 seqDemand (WwLazy a) = a `seq` ()
78 seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
82 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
86 %************************************************************************
88 \subsection{Functions over @Demand@}
90 %************************************************************************
93 isLazy :: Demand -> Bool
94 isLazy (WwLazy _) = True
97 isStrict :: Demand -> Bool
98 isStrict d = not (isLazy d)
100 isPrim :: Demand -> Bool
106 %************************************************************************
108 \subsection{Instances}
110 %************************************************************************
114 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
116 pp_bot | bot = ptext SLIT("B")
120 pprDemand (WwLazy False) = char 'L'
121 pprDemand (WwLazy True) = char 'A'
122 pprDemand WwStrict = char 'S'
123 pprDemand WwPrim = char 'P'
124 pprDemand WwEnum = char 'E'
125 pprDemand (WwUnpack wu args) = char ch <> parens (hcat (map pprDemand args))
127 ch = if wu then 'U' else 'u'
129 instance Outputable Demand where
130 ppr (WwLazy False) = empty
131 ppr other_demand = ptext SLIT("__D") <+> pprDemand other_demand
133 instance Show Demand where
134 showsPrec p d = showsPrecSDoc p (ppr d)
136 -- Reading demands is done in Lex.lhs
140 %************************************************************************
142 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
144 %************************************************************************
146 We specify the strictness of a function by giving information about
147 each of the ``wrapper's'' arguments (see the description about
148 worker/wrapper-style transformations in the PJ/Launchbury paper on
151 The list of @Demands@ specifies: (a)~the strictness properties of a
152 function's arguments; and (b)~the type signature of that worker (if it
153 exists); i.e. its calling convention.
155 Note that the existence of a worker function is now denoted by the Id's
162 | StrictnessInfo [Demand] -- Demands on the arguments.
164 Bool -- True <=> the function diverges regardless of its arguments
165 -- Useful for "error" and other disguised variants thereof.
166 -- BUT NB: f = \x y. error "urk"
167 -- will have info SI [SS] True
168 -- but still (f) and (f 2) are not bot; only (f 3 2) is bot
171 -- NOTA BENE: if the arg demands are, say, [S,L], this means that
172 -- (f bot) is not necy bot, only (f bot x) is bot
173 -- We simply cannot express accurately the strictness of a function
174 -- like f = \x -> case x of (a,b) -> \y -> ...
175 -- The up-side is that we don't need to restrict the strictness info
176 -- to the visible arity of the function.
178 seqStrictnessInfo :: StrictnessInfo -> ()
179 seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
180 seqStrictnessInfo other = ()
184 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
186 mkStrictnessInfo (xs, is_bot)
187 | all totally_boring xs && not is_bot = NoStrictnessInfo -- Uninteresting
188 | otherwise = StrictnessInfo xs is_bot
190 totally_boring (WwLazy False) = True
191 totally_boring other = False
193 noStrictnessInfo = NoStrictnessInfo
195 isBottomingStrictness (StrictnessInfo _ bot) = bot
196 isBottomingStrictness NoStrictnessInfo = False
198 -- appIsBottom returns true if an application to n args would diverge
199 appIsBottom (StrictnessInfo ds bot) n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
200 appIsBottom NoStrictnessInfo n = False
202 ppStrictnessInfo NoStrictnessInfo = empty
203 ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
207 #endif /* OLD_STRICTNESS */