2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
5 \section[Demand]{@Demand@: the amount of demand on a value}
15 wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum,
16 isStrict, isLazy, isPrim,
18 pprDemands, seqDemand, seqDemands,
23 ppStrictnessInfo, seqStrictnessInfo,
24 isBottomingStrictness, appIsBottom,
28 #include "HsVersions.h"
35 %************************************************************************
37 \subsection{The @Demand@ data type}
39 %************************************************************************
43 = WwLazy -- Argument is lazy as far as we know
44 MaybeAbsent -- (does not imply worker's existence [etc]).
45 -- If MaybeAbsent == True, then it is
46 -- *definitely* lazy. (NB: Absence implies
49 | WwStrict -- Argument is strict but that's all we know
50 -- (does not imply worker's existence or any
51 -- calling-convention magic)
53 | WwUnpack -- Argument is strict & a single-constructor type
54 Bool -- True <=> wrapper unpacks it; False <=> doesn't
55 [Demand] -- Its constituent parts (whose StrictInfos
56 -- are in the list) should be passed
57 -- as arguments to the worker.
59 | WwPrim -- Argument is of primitive type, therefore
60 -- strict; doesn't imply existence of a worker;
61 -- argument should be passed as is to worker.
63 | WwEnum -- Argument is strict & an enumeration type;
64 -- an Int# representing the tag (start counting
65 -- at zero) should be passed to the worker.
68 type MaybeAbsent = Bool -- True <=> not even used
70 -- versions that don't worry about Absence:
71 wwLazy, wwStrict, wwPrim, wwEnum :: Demand
72 wwUnpack :: [Demand] -> Demand
76 wwUnpack xs = WwUnpack False xs
80 seqDemand :: Demand -> ()
81 seqDemand (WwLazy a) = a `seq` ()
82 seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
85 seqDemands :: [Demand] -> ()
87 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
91 %************************************************************************
93 \subsection{Functions over @Demand@}
95 %************************************************************************
98 isLazy :: Demand -> Bool
99 isLazy (WwLazy _) = True
102 isStrict :: Demand -> Bool
103 isStrict d = not (isLazy d)
105 isPrim :: Demand -> Bool
111 %************************************************************************
113 \subsection{Instances}
115 %************************************************************************
119 pprDemands :: [Demand] -> Bool -> SDoc
120 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
122 pp_bot | bot = ptext (sLit "B")
126 pprDemand :: Demand -> SDoc
127 pprDemand (WwLazy False) = char 'L'
128 pprDemand (WwLazy True) = char 'A'
129 pprDemand WwStrict = char 'S'
130 pprDemand WwPrim = char 'P'
131 pprDemand WwEnum = char 'E'
132 pprDemand (WwUnpack wu args) = char ch <> parens (hcat (map pprDemand args))
134 ch = if wu then 'U' else 'u'
136 instance Outputable Demand where
137 ppr (WwLazy False) = empty
138 ppr other_demand = ptext (sLit "__D") <+> pprDemand other_demand
140 instance Show Demand where
141 showsPrec p d = showsPrecSDoc p (ppr d)
143 -- Reading demands is done in Lex.lhs
147 %************************************************************************
149 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
151 %************************************************************************
153 We specify the strictness of a function by giving information about
154 each of the ``wrapper's'' arguments (see the description about
155 worker/wrapper-style transformations in the PJ/Launchbury paper on
158 The list of @Demands@ specifies: (a)~the strictness properties of a
159 function's arguments; and (b)~the type signature of that worker (if it
160 exists); i.e. its calling convention.
162 Note that the existence of a worker function is now denoted by the Id's
169 | StrictnessInfo [Demand] -- Demands on the arguments.
171 Bool -- True <=> the function diverges regardless of its arguments
172 -- Useful for "error" and other disguised variants thereof.
173 -- BUT NB: f = \x y. error "urk"
174 -- will have info SI [SS] True
175 -- but still (f) and (f 2) are not bot; only (f 3 2) is bot
178 -- NOTA BENE: if the arg demands are, say, [S,L], this means that
179 -- (f bot) is not necy bot, only (f bot x) is bot
180 -- We simply cannot express accurately the strictness of a function
181 -- like f = \x -> case x of (a,b) -> \y -> ...
182 -- The up-side is that we don't need to restrict the strictness info
183 -- to the visible arity of the function.
185 seqStrictnessInfo :: StrictnessInfo -> ()
186 seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
187 seqStrictnessInfo _ = ()
191 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
193 mkStrictnessInfo (xs, is_bot)
194 | all totally_boring xs && not is_bot = NoStrictnessInfo -- Uninteresting
195 | otherwise = StrictnessInfo xs is_bot
197 totally_boring (WwLazy False) = True
198 totally_boring _ = False
200 noStrictnessInfo :: StrictnessInfo
201 noStrictnessInfo = NoStrictnessInfo
203 isBottomingStrictness :: StrictnessInfo -> Bool
204 isBottomingStrictness (StrictnessInfo _ bot) = bot
205 isBottomingStrictness NoStrictnessInfo = False
207 -- appIsBottom returns true if an application to n args would diverge
208 appIsBottom :: StrictnessInfo -> Int -> Bool
209 appIsBottom (StrictnessInfo ds bot) n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
210 appIsBottom NoStrictnessInfo _ = False
212 ppStrictnessInfo :: StrictnessInfo -> SDoc
213 ppStrictnessInfo NoStrictnessInfo = empty
214 ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
218 #endif /* OLD_STRICTNESS */