2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Demand]{@Demand@: the amount of demand on a value}
10 wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum,
11 isStrict, isLazy, isPrim,
13 pprDemands, seqDemand, seqDemands,
18 ppStrictnessInfo, seqStrictnessInfo,
19 isBottomingStrictness, appIsBottom,
23 #include "HsVersions.h"
26 import Util ( listLengthCmp )
30 %************************************************************************
32 \subsection{The @Demand@ data type}
34 %************************************************************************
38 = WwLazy -- Argument is lazy as far as we know
39 MaybeAbsent -- (does not imply worker's existence [etc]).
40 -- If MaybeAbsent == True, then it is
41 -- *definitely* lazy. (NB: Absence implies
44 | WwStrict -- Argument is strict but that's all we know
45 -- (does not imply worker's existence or any
46 -- calling-convention magic)
48 | 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 wwUnpack xs = WwUnpack False xs
72 seqDemand :: Demand -> ()
73 seqDemand (WwLazy a) = a `seq` ()
74 seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
78 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
82 %************************************************************************
84 \subsection{Functions over @Demand@}
86 %************************************************************************
89 isLazy :: Demand -> Bool
90 isLazy (WwLazy _) = True
93 isStrict :: Demand -> Bool
94 isStrict d = not (isLazy d)
96 isPrim :: Demand -> Bool
102 %************************************************************************
104 \subsection{Instances}
106 %************************************************************************
110 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
112 pp_bot | bot = ptext SLIT("B")
116 pprDemand (WwLazy False) = char 'L'
117 pprDemand (WwLazy True) = char 'A'
118 pprDemand WwStrict = char 'S'
119 pprDemand WwPrim = char 'P'
120 pprDemand WwEnum = char 'E'
121 pprDemand (WwUnpack wu args) = char ch <> parens (hcat (map pprDemand args))
123 ch = if wu then 'U' else 'u'
125 instance Outputable Demand where
126 ppr (WwLazy False) = empty
127 ppr other_demand = ptext SLIT("__D") <+> pprDemand other_demand
129 instance Show Demand where
130 showsPrec p d = showsPrecSDoc p (ppr d)
132 -- Reading demands is done in Lex.lhs
136 %************************************************************************
138 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
140 %************************************************************************
142 We specify the strictness of a function by giving information about
143 each of the ``wrapper's'' arguments (see the description about
144 worker/wrapper-style transformations in the PJ/Launchbury paper on
147 The list of @Demands@ specifies: (a)~the strictness properties of a
148 function's arguments; and (b)~the type signature of that worker (if it
149 exists); i.e. its calling convention.
151 Note that the existence of a worker function is now denoted by the Id's
158 | StrictnessInfo [Demand] -- Demands on the arguments.
160 Bool -- True <=> the function diverges regardless of its arguments
161 -- Useful for "error" and other disguised variants thereof.
162 -- BUT NB: f = \x y. error "urk"
163 -- will have info SI [SS] True
164 -- but still (f) and (f 2) are not bot; only (f 3 2) is bot
167 -- NOTA BENE: if the arg demands are, say, [S,L], this means that
168 -- (f bot) is not necy bot, only (f bot x) is bot
169 -- We simply cannot express accurately the strictness of a function
170 -- like f = \x -> case x of (a,b) -> \y -> ...
171 -- The up-side is that we don't need to restrict the strictness info
172 -- to the visible arity of the function.
174 seqStrictnessInfo :: StrictnessInfo -> ()
175 seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
176 seqStrictnessInfo other = ()
180 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
182 mkStrictnessInfo (xs, is_bot)
183 | all totally_boring xs && not is_bot = NoStrictnessInfo -- Uninteresting
184 | otherwise = StrictnessInfo xs is_bot
186 totally_boring (WwLazy False) = True
187 totally_boring other = False
189 noStrictnessInfo = NoStrictnessInfo
191 isBottomingStrictness (StrictnessInfo _ bot) = bot
192 isBottomingStrictness NoStrictnessInfo = False
194 -- appIsBottom returns true if an application to n args would diverge
195 appIsBottom (StrictnessInfo ds bot) n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
196 appIsBottom NoStrictnessInfo n = False
198 ppStrictnessInfo NoStrictnessInfo = empty
199 ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]