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
16 #include "HsVersions.h"
18 import BasicTypes ( NewOrData(..) )
23 %************************************************************************
25 \subsection{The @Demand@ data type}
27 %************************************************************************
31 = WwLazy -- Argument is lazy as far as we know
32 MaybeAbsent -- (does not imply worker's existence [etc]).
33 -- If MaybeAbsent == True, then it is
34 -- *definitely* lazy. (NB: Absence implies
37 | WwStrict -- Argument is strict but that's all we know
38 -- (does not imply worker's existence or any
39 -- calling-convention magic)
41 | WwUnpack -- Argument is strict & a single-constructor type
43 Bool -- True <=> wrapper unpacks it; False <=> doesn't
44 [Demand] -- Its constituent parts (whose StrictInfos
45 -- are in the list) should be passed
46 -- as arguments to the worker.
48 | WwPrim -- Argument is of primitive type, therefore
49 -- strict; doesn't imply existence of a worker;
50 -- argument should be passed as is to worker.
52 | WwEnum -- Argument is strict & an enumeration type;
53 -- an Int# representing the tag (start counting
54 -- at zero) should be passed to the worker.
57 type MaybeAbsent = Bool -- True <=> not even used
59 -- versions that don't worry about Absence:
62 wwUnpackData xs = WwUnpack DataType False xs
63 wwUnpackNew x = WwUnpack NewType False [x]
67 seqDemand :: Demand -> ()
68 seqDemand (WwLazy a) = a `seq` ()
69 seqDemand (WwUnpack nd b ds) = nd `seq` b `seq` seqDemands ds
73 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
77 %************************************************************************
79 \subsection{Functions over @Demand@}
81 %************************************************************************
84 isStrict :: Demand -> Bool
85 isStrict (WwUnpack NewType _ ds) = isStrict (head ds)
86 isStrict (WwUnpack other _ _) = True
87 isStrict WwStrict = True
88 isStrict WwEnum = True
89 isStrict WwPrim = True
92 isPrim :: Demand -> Bool
98 isLazy :: Demand -> Bool
99 isLazy (WwLazy False) = True -- NB "Absent" args do *not* count!
100 isLazy _ = False -- (as they imply a worker)
104 %************************************************************************
106 \subsection{Instances}
108 %************************************************************************
112 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
114 pp_bot | bot = ptext SLIT("B")
118 pprDemand (WwLazy False) = char 'L'
119 pprDemand (WwLazy True) = char 'A'
120 pprDemand WwStrict = char 'S'
121 pprDemand WwPrim = char 'P'
122 pprDemand WwEnum = char 'E'
123 pprDemand (WwUnpack nd wu args) = char ch <> parens (hcat (map pprDemand args))
131 instance Outputable Demand where
132 ppr (WwLazy False) = empty
133 ppr other_demand = ptext SLIT("__D") <+> pprDemand other_demand
135 instance Show Demand where
136 showsPrec p d = showsPrecSDoc p (ppr d)
141 {- ------------------- OMITTED NOW -------------------------------
142 -- Reading demands is done in Lex.lhs
143 -- Also note that the (old) code here doesn't take proper
144 -- account of the 'B' suffix for bottoming functions
146 #ifdef REALLY_HASKELL_1_3
148 instance Read Demand where
149 readList str = read_em [] str
151 instance Show Demand where
152 showsPrec p d = showsPrecSDoc p (ppr d)
156 instance Text Demand where
157 readList str = read_em [] str
158 showsPrec p d = showsPrecSDoc p (ppr d)
161 readDemands :: String ->
163 read_em acc ('L' : xs) = read_em (WwLazy False : acc) xs
164 read_em acc ('A' : xs) = read_em (WwLazy True : acc) xs
165 read_em acc ('S' : xs) = read_em (WwStrict : acc) xs
166 read_em acc ('P' : xs) = read_em (WwPrim : acc) xs
167 read_em acc ('E' : xs) = read_em (WwEnum : acc) xs
168 read_em acc (')' : xs) = [(reverse acc, xs)]
169 read_em acc ( 'U' : '(' : xs) = do_unpack DataType True acc xs
170 read_em acc ( 'u' : '(' : xs) = do_unpack DataType False acc xs
171 read_em acc ( 'N' : '(' : xs) = do_unpack NewType True acc xs
172 read_em acc ( 'n' : '(' : xs) = do_unpack NewType False acc xs
173 read_em acc rest = [(reverse acc, rest)]
175 do_unpack new_or_data wrapper_unpacks acc xs
176 = case (read_em [] xs) of
177 [(stuff, rest)] -> read_em (WwUnpack new_or_data wrapper_unpacks stuff : acc) rest
178 _ -> pprPanic "Demand.do_unpack:" (ppr acc <+> dcolon <> text xs)
180 -------------------- END OF OMISSION ------------------------------ -}