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:
73 wwUnpack xs = WwUnpack False xs
77 seqDemand :: Demand -> ()
78 seqDemand (WwLazy a) = a `seq` ()
79 seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
83 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
87 %************************************************************************
89 \subsection{Functions over @Demand@}
91 %************************************************************************
94 isLazy :: Demand -> Bool
95 isLazy (WwLazy _) = True
98 isStrict :: Demand -> Bool
99 isStrict d = not (isLazy d)
101 isPrim :: Demand -> Bool
107 %************************************************************************
109 \subsection{Instances}
111 %************************************************************************
115 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
117 pp_bot | bot = ptext SLIT("B")
121 pprDemand (WwLazy False) = char 'L'
122 pprDemand (WwLazy True) = char 'A'
123 pprDemand WwStrict = char 'S'
124 pprDemand WwPrim = char 'P'
125 pprDemand WwEnum = char 'E'
126 pprDemand (WwUnpack wu args) = char ch <> parens (hcat (map pprDemand args))
128 ch = if wu then 'U' else 'u'
130 instance Outputable Demand where
131 ppr (WwLazy False) = empty
132 ppr other_demand = ptext SLIT("__D") <+> pprDemand other_demand
134 instance Show Demand where
135 showsPrec p d = showsPrecSDoc p (ppr d)
137 -- Reading demands is done in Lex.lhs
141 %************************************************************************
143 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
145 %************************************************************************
147 We specify the strictness of a function by giving information about
148 each of the ``wrapper's'' arguments (see the description about
149 worker/wrapper-style transformations in the PJ/Launchbury paper on
152 The list of @Demands@ specifies: (a)~the strictness properties of a
153 function's arguments; and (b)~the type signature of that worker (if it
154 exists); i.e. its calling convention.
156 Note that the existence of a worker function is now denoted by the Id's
163 | StrictnessInfo [Demand] -- Demands on the arguments.
165 Bool -- True <=> the function diverges regardless of its arguments
166 -- Useful for "error" and other disguised variants thereof.
167 -- BUT NB: f = \x y. error "urk"
168 -- will have info SI [SS] True
169 -- but still (f) and (f 2) are not bot; only (f 3 2) is bot
172 -- NOTA BENE: if the arg demands are, say, [S,L], this means that
173 -- (f bot) is not necy bot, only (f bot x) is bot
174 -- We simply cannot express accurately the strictness of a function
175 -- like f = \x -> case x of (a,b) -> \y -> ...
176 -- The up-side is that we don't need to restrict the strictness info
177 -- to the visible arity of the function.
179 seqStrictnessInfo :: StrictnessInfo -> ()
180 seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
181 seqStrictnessInfo other = ()
185 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
187 mkStrictnessInfo (xs, is_bot)
188 | all totally_boring xs && not is_bot = NoStrictnessInfo -- Uninteresting
189 | otherwise = StrictnessInfo xs is_bot
191 totally_boring (WwLazy False) = True
192 totally_boring other = False
194 noStrictnessInfo = NoStrictnessInfo
196 isBottomingStrictness (StrictnessInfo _ bot) = bot
197 isBottomingStrictness NoStrictnessInfo = False
199 -- appIsBottom returns true if an application to n args would diverge
200 appIsBottom (StrictnessInfo ds bot) n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
201 appIsBottom NoStrictnessInfo n = False
203 ppStrictnessInfo NoStrictnessInfo = empty
204 ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
208 #endif /* OLD_STRICTNESS */