Demand.lhs 6.22 KB
 simonpj committed Dec 19, 1996 1 %  Simon Marlow committed Oct 11, 2006 2 % (c) The University of Glasgow 2006  simonm committed Dec 02, 1998 3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998  simonpj committed Dec 19, 1996 4 5 6 7 % \section[Demand]{@Demand@: the amount of demand on a value} \begin{code}  Ian Lynagh committed Sep 03, 2007 8 {-# OPTIONS -w #-}  Ian Lynagh committed Sep 01, 2007 9 10 11 -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See  Ian Lynagh committed Sep 03, 2007 12 -- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings  Ian Lynagh committed Sep 01, 2007 13 14 -- for details  simonmar committed Mar 24, 2003 15 16 17 18 #ifndef OLD_STRICTNESS module Demand () where #else  sof committed May 26, 1997 19 20 module Demand( Demand(..),  simonpj committed Dec 19, 1996 21   simonpj committed Jun 25, 2001 22  wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum,  simonpj committed May 18, 1999 23  isStrict, isLazy, isPrim,  sof committed May 26, 1997 24   simonpj committed Mar 23, 2000 25 26 27 28 29 30 31  pprDemands, seqDemand, seqDemands, StrictnessInfo(..), mkStrictnessInfo, noStrictnessInfo, ppStrictnessInfo, seqStrictnessInfo, isBottomingStrictness, appIsBottom,  simonpj committed May 18, 2001 32   sof committed May 26, 1997 33 34  ) where  simonm committed Jan 08, 1998 35 36 #include "HsVersions.h"  simonpj committed Dec 19, 1996 37 import Outputable  Simon Marlow committed Oct 11, 2006 38 import Util  simonpj committed Dec 19, 1996 39 40 41 42 43 44 45 46 47 48 49 50 51 52 \end{code} %************************************************************************ %* * \subsection{The @Demand@ data type} %* * %************************************************************************ \begin{code} data Demand = WwLazy -- Argument is lazy as far as we know MaybeAbsent -- (does not imply worker's existence [etc]). -- If MaybeAbsent == True, then it is  simonmar committed Mar 31, 2005 53  -- *definitely* lazy. (NB: Absence implies  simonpj committed Dec 19, 1996 54 55 56 57 58 59  -- a worker...) | WwStrict -- Argument is strict but that's all we know -- (does not imply worker's existence or any -- calling-convention magic)  sof committed May 26, 1997 60  | WwUnpack -- Argument is strict & a single-constructor type  simonpj committed Jan 17, 1997 61  Bool -- True <=> wrapper unpacks it; False <=> doesn't  sof committed May 26, 1997 62  [Demand] -- Its constituent parts (whose StrictInfos  simonpj committed Dec 19, 1996 63 64 65 66 67 68 69 70 71 72  -- are in the list) should be passed -- as arguments to the worker. | WwPrim -- Argument is of primitive type, therefore -- strict; doesn't imply existence of a worker; -- argument should be passed as is to worker. | WwEnum -- Argument is strict & an enumeration type; -- an Int# representing the tag (start counting -- at zero) should be passed to the worker.  sof committed May 26, 1997 73  deriving( Eq )  simonpj committed Dec 19, 1996 74 75 76 77 78 79  type MaybeAbsent = Bool -- True <=> not even used -- versions that don't worry about Absence: wwLazy = WwLazy False wwStrict = WwStrict  simonpj committed Jun 25, 2001 80 wwUnpack xs = WwUnpack False xs  simonpj committed Dec 19, 1996 81 82 wwPrim = WwPrim wwEnum = WwEnum  simonpj committed Jul 14, 1999 83 84  seqDemand :: Demand -> ()  simonpj committed Jun 25, 2001 85 86 87 seqDemand (WwLazy a) = a seq () seqDemand (WwUnpack b ds) = b seq seqDemands ds seqDemand other = ()  simonpj committed Jul 14, 1999 88 89 90  seqDemands [] = () seqDemands (d:ds) = seqDemand d seq seqDemands ds  simonpj committed Dec 19, 1996 91 92 93 94 95 96 97 98 99 100 \end{code} %************************************************************************ %* * \subsection{Functions over @Demand@} %* * %************************************************************************ \begin{code}  simonpj committed May 25, 2000 101 102 103 104 isLazy :: Demand -> Bool isLazy (WwLazy _) = True isLazy _ = False  simonpj committed Dec 19, 1996 105 isStrict :: Demand -> Bool  simonpj committed May 25, 2000 106 isStrict d = not (isLazy d)  simonpj committed May 18, 1999 107 108 109 110  isPrim :: Demand -> Bool isPrim WwPrim = True isPrim other = False  simonm committed Dec 02, 1998 111 112 \end{code}  simonpj committed Dec 19, 1996 113 114 115 116 117 118 119  %************************************************************************ %* * \subsection{Instances} %* * %************************************************************************  simonpj committed Dec 18, 1998 120   simonpj committed Dec 19, 1996 121 \begin{code}  simonpj committed Dec 18, 1998 122 123 124 125 126 127 128 129 130 131 132 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot where pp_bot | bot = ptext SLIT("B") | otherwise = empty pprDemand (WwLazy False) = char 'L' pprDemand (WwLazy True) = char 'A' pprDemand WwStrict = char 'S' pprDemand WwPrim = char 'P' pprDemand WwEnum = char 'E'  simonpj committed Jun 25, 2001 133 pprDemand (WwUnpack wu args) = char ch <> parens (hcat (map pprDemand args))  simonpj committed Dec 18, 1998 134  where  simonpj committed Jun 25, 2001 135  ch = if wu then 'U' else 'u'  simonpj committed Dec 18, 1998 136 137 138 139 140 141 142  instance Outputable Demand where ppr (WwLazy False) = empty ppr other_demand = ptext SLIT("__D") <+> pprDemand other_demand instance Show Demand where showsPrec p d = showsPrecSDoc p (ppr d)  simonpj committed Mar 23, 2000 143 144  -- Reading demands is done in Lex.lhs  simonpj committed Dec 18, 1998 145 146 147 \end{code}  simonpj committed Mar 23, 2000 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 %************************************************************************ %* * \subsection[strictness-IdInfo]{Strictness info about an @Id@} %* * %************************************************************************ We specify the strictness of a function by giving information about each of the wrapper's'' arguments (see the description about worker/wrapper-style transformations in the PJ/Launchbury paper on unboxed types). The list of @Demands@ specifies: (a)~the strictness properties of a function's arguments; and (b)~the type signature of that worker (if it exists); i.e. its calling convention. Note that the existence of a worker function is now denoted by the Id's workerInfo field. \begin{code} data StrictnessInfo = NoStrictnessInfo | StrictnessInfo [Demand] -- Demands on the arguments. Bool -- True <=> the function diverges regardless of its arguments -- Useful for "error" and other disguised variants thereof. -- BUT NB: f = \x y. error "urk" -- will have info SI [SS] True -- but still (f) and (f 2) are not bot; only (f 3 2) is bot  simonpj committed May 25, 2000 177  deriving( Eq )  simonpj committed Mar 23, 2000 178 179 180 181 182 183 184 185 186 187 188 189 190  -- NOTA BENE: if the arg demands are, say, [S,L], this means that -- (f bot) is not necy bot, only (f bot x) is bot -- We simply cannot express accurately the strictness of a function -- like f = \x -> case x of (a,b) -> \y -> ... -- The up-side is that we don't need to restrict the strictness info -- to the visible arity of the function. seqStrictnessInfo :: StrictnessInfo -> () seqStrictnessInfo (StrictnessInfo ds b) = b seq seqDemands ds seqStrictnessInfo other = () \end{code}  simonpj committed Dec 18, 1998 191 \begin{code}  simonpj committed Mar 23, 2000 192 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo  simonpj committed Dec 18, 1998 193   simonpj committed Mar 23, 2000 194 mkStrictnessInfo (xs, is_bot)  simonpj committed May 25, 2000 195 196 197 198 199  | all totally_boring xs && not is_bot = NoStrictnessInfo -- Uninteresting | otherwise = StrictnessInfo xs is_bot where totally_boring (WwLazy False) = True totally_boring other = False  sof committed May 26, 1997 200   simonpj committed Mar 23, 2000 201 noStrictnessInfo = NoStrictnessInfo  simonm committed Dec 02, 1998 202   simonpj committed Mar 23, 2000 203 204 isBottomingStrictness (StrictnessInfo _ bot) = bot isBottomingStrictness NoStrictnessInfo = False  sof committed May 26, 1997 205   simonpj committed Mar 23, 2000 206 -- appIsBottom returns true if an application to n args would diverge  sof committed Oct 25, 2001 207 appIsBottom (StrictnessInfo ds bot) n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.  simonpj committed Mar 23, 2000 208 appIsBottom NoStrictnessInfo n = False  simonpj committed Dec 19, 1996 209   simonpj committed May 25, 2000 210 211 ppStrictnessInfo NoStrictnessInfo = empty ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]  simonpj committed Dec 19, 1996 212 \end{code}  simonpj committed Dec 18, 1998 213   simonmar committed Mar 24, 2003 214 215 216 \begin{code} #endif /* OLD_STRICTNESS */ \end{code}