2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Demand]{@Demand@: the amount of demand on a value}
10 wwLazy, wwStrict, wwUnpackData, wwUnpackNew, wwPrim, wwEnum,
11 isStrict, isLazy, isPrim,
13 pprDemands, seqDemand, seqDemands,
18 ppStrictnessInfo, seqStrictnessInfo,
19 isBottomingStrictness, appIsBottom,
22 #include "HsVersions.h"
24 import BasicTypes ( NewOrData(..) )
29 %************************************************************************
31 \subsection{The @Demand@ data type}
33 %************************************************************************
37 = WwLazy -- Argument is lazy as far as we know
38 MaybeAbsent -- (does not imply worker's existence [etc]).
39 -- If MaybeAbsent == True, then it is
40 -- *definitely* lazy. (NB: Absence implies
43 | WwStrict -- Argument is strict but that's all we know
44 -- (does not imply worker's existence or any
45 -- calling-convention magic)
47 | WwUnpack -- Argument is strict & a single-constructor type
49 Bool -- True <=> wrapper unpacks it; False <=> doesn't
50 [Demand] -- Its constituent parts (whose StrictInfos
51 -- are in the list) should be passed
52 -- as arguments to the worker.
54 | WwPrim -- Argument is of primitive type, therefore
55 -- strict; doesn't imply existence of a worker;
56 -- argument should be passed as is to worker.
58 | WwEnum -- Argument is strict & an enumeration type;
59 -- an Int# representing the tag (start counting
60 -- at zero) should be passed to the worker.
63 type MaybeAbsent = Bool -- True <=> not even used
65 -- versions that don't worry about Absence:
68 wwUnpackData xs = WwUnpack DataType False xs
69 wwUnpackNew x = ASSERT( isStrict x) -- Invariant
70 WwUnpack NewType False [x]
74 seqDemand :: Demand -> ()
75 seqDemand (WwLazy a) = a `seq` ()
76 seqDemand (WwUnpack nd b ds) = nd `seq` b `seq` seqDemands ds
80 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
84 %************************************************************************
86 \subsection{Functions over @Demand@}
88 %************************************************************************
91 isLazy :: Demand -> Bool
92 -- Even a demand of (WwUnpack NewType _ _) is strict
93 -- We don't create such a thing unless the demand inside is strict
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 nd wu args) = char ch <> parens (hcat (map pprDemand args))
133 instance Outputable Demand where
134 ppr (WwLazy False) = empty
135 ppr other_demand = ptext SLIT("__D") <+> pprDemand other_demand
137 instance Show Demand where
138 showsPrec p d = showsPrecSDoc p (ppr d)
140 -- Reading demands is done in Lex.lhs
144 %************************************************************************
146 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
148 %************************************************************************
150 We specify the strictness of a function by giving information about
151 each of the ``wrapper's'' arguments (see the description about
152 worker/wrapper-style transformations in the PJ/Launchbury paper on
155 The list of @Demands@ specifies: (a)~the strictness properties of a
156 function's arguments; and (b)~the type signature of that worker (if it
157 exists); i.e. its calling convention.
159 Note that the existence of a worker function is now denoted by the Id's
166 | StrictnessInfo [Demand] -- Demands on the arguments.
168 Bool -- True <=> the function diverges regardless of its arguments
169 -- Useful for "error" and other disguised variants thereof.
170 -- BUT NB: f = \x y. error "urk"
171 -- will have info SI [SS] True
172 -- but still (f) and (f 2) are not bot; only (f 3 2) is bot
175 -- NOTA BENE: if the arg demands are, say, [S,L], this means that
176 -- (f bot) is not necy bot, only (f bot x) is bot
177 -- We simply cannot express accurately the strictness of a function
178 -- like f = \x -> case x of (a,b) -> \y -> ...
179 -- The up-side is that we don't need to restrict the strictness info
180 -- to the visible arity of the function.
182 seqStrictnessInfo :: StrictnessInfo -> ()
183 seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
184 seqStrictnessInfo other = ()
188 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
190 mkStrictnessInfo (xs, is_bot)
191 | all totally_boring xs && not is_bot = NoStrictnessInfo -- Uninteresting
192 | otherwise = StrictnessInfo xs is_bot
194 totally_boring (WwLazy False) = True
195 totally_boring other = False
197 noStrictnessInfo = NoStrictnessInfo
199 isBottomingStrictness (StrictnessInfo _ bot) = bot
200 isBottomingStrictness NoStrictnessInfo = False
202 -- appIsBottom returns true if an application to n args would diverge
203 appIsBottom (StrictnessInfo ds bot) n = bot && (n >= length ds)
204 appIsBottom NoStrictnessInfo n = False
206 ppStrictnessInfo NoStrictnessInfo = empty
207 ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]