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,
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]
69 %************************************************************************
71 \subsection{Functions over @Demand@}
73 %************************************************************************
76 isStrict :: Demand -> Bool
77 isStrict (WwUnpack NewType _ ds) = isStrict (head ds)
78 isStrict (WwUnpack other _ _) = True
79 isStrict WwStrict = True
80 isStrict WwEnum = True
81 isStrict WwPrim = True
84 isPrim :: Demand -> Bool
90 isLazy :: Demand -> Bool
91 isLazy (WwLazy False) = True -- NB "Absent" args do *not* count!
92 isLazy _ = False -- (as they imply a worker)
96 %************************************************************************
98 \subsection{Instances}
100 %************************************************************************
104 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
106 pp_bot | bot = ptext SLIT("B")
110 pprDemand (WwLazy False) = char 'L'
111 pprDemand (WwLazy True) = char 'A'
112 pprDemand WwStrict = char 'S'
113 pprDemand WwPrim = char 'P'
114 pprDemand WwEnum = char 'E'
115 pprDemand (WwUnpack nd wu args) = char ch <> parens (hcat (map pprDemand args))
123 instance Outputable Demand where
124 ppr (WwLazy False) = empty
125 ppr other_demand = ptext SLIT("__D") <+> pprDemand other_demand
127 instance Show Demand where
128 showsPrec p d = showsPrecSDoc p (ppr d)
133 {- ------------------- OMITTED NOW -------------------------------
134 -- Reading demands is done in Lex.lhs
135 -- Also note that the (old) code here doesn't take proper
136 -- account of the 'B' suffix for bottoming functions
138 #ifdef REALLY_HASKELL_1_3
140 instance Read Demand where
141 readList str = read_em [] str
143 instance Show Demand where
144 showsPrec p d = showsPrecSDoc p (ppr d)
148 instance Text Demand where
149 readList str = read_em [] str
150 showsPrec p d = showsPrecSDoc p (ppr d)
153 readDemands :: String ->
155 read_em acc ('L' : xs) = read_em (WwLazy False : acc) xs
156 read_em acc ('A' : xs) = read_em (WwLazy True : acc) xs
157 read_em acc ('S' : xs) = read_em (WwStrict : acc) xs
158 read_em acc ('P' : xs) = read_em (WwPrim : acc) xs
159 read_em acc ('E' : xs) = read_em (WwEnum : acc) xs
160 read_em acc (')' : xs) = [(reverse acc, xs)]
161 read_em acc ( 'U' : '(' : xs) = do_unpack DataType True acc xs
162 read_em acc ( 'u' : '(' : xs) = do_unpack DataType False acc xs
163 read_em acc ( 'N' : '(' : xs) = do_unpack NewType True acc xs
164 read_em acc ( 'n' : '(' : xs) = do_unpack NewType False acc xs
165 read_em acc rest = [(reverse acc, rest)]
167 do_unpack new_or_data wrapper_unpacks acc xs
168 = case (read_em [] xs) of
169 [(stuff, rest)] -> read_em (WwUnpack new_or_data wrapper_unpacks stuff : acc) rest
170 _ -> pprPanic "Demand.do_unpack:" (ppr acc <+> dcolon <> text xs)
172 -------------------- END OF OMISSION ------------------------------ -}