compiler/basicTypes/Demand.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[Demand]{@Demand@: the amount of demand on a value}
   6
   7 \begin{code}
   8 #ifndef OLD_STRICTNESS
   9 module Demand () where
  10 #else
  11
  12 module Demand(
  13         Demand(..),
  14
  15         wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum,
  16         isStrict, isLazy, isPrim,
  17
  18         pprDemands, seqDemand, seqDemands,
  19
  20         StrictnessInfo(..),
  21         mkStrictnessInfo,
  22         noStrictnessInfo,
  23         ppStrictnessInfo, seqStrictnessInfo,
  24         isBottomingStrictness, appIsBottom,
  25
  26      ) where
  27
  28 #include "HsVersions.h"
  29
  30 import Outputable
  31 import Util
  32 \end{code}
  33
  34
  35 %************************************************************************
  36 %*                                                                      *
  37 \subsection{The @Demand@ data type}
  38 %*                                                                      *
  39 %************************************************************************
  40
  41 \begin{code}
  42 data Demand
  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
  47                         -- a worker...)
  48
  49   | WwStrict            -- Argument is strict but that's all we know
  50                         -- (does not imply worker's existence or any
  51                         -- calling-convention magic)
  52
  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.
  58
  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.
  62
  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.
  66   deriving( Eq )
  67
  68 type MaybeAbsent = Bool -- True <=> not even used
  69
  70 -- versions that don't worry about Absence:
  71 wwLazy, wwStrict, wwPrim, wwEnum :: Demand
  72 wwUnpack :: [Demand] -> Demand
  73
  74 wwLazy      = WwLazy      False
  75 wwStrict    = WwStrict
  76 wwUnpack xs = WwUnpack False xs
  77 wwPrim      = WwPrim
  78 wwEnum      = WwEnum
  79
  80 seqDemand :: Demand -> ()
  81 seqDemand (WwLazy a)      = a `seq` ()
  82 seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
  83 seqDemand _               = ()
  84
  85 seqDemands :: [Demand] -> ()
  86 seqDemands [] = ()
  87 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
  88 \end{code}
  89
  90
  91 %************************************************************************
  92 %*                                                                      *
  93 \subsection{Functions over @Demand@}
  94 %*                                                                      *
  95 %************************************************************************
  96
  97 \begin{code}
  98 isLazy :: Demand -> Bool
  99 isLazy (WwLazy _) = True
 100 isLazy _          = False
 101
 102 isStrict :: Demand -> Bool
 103 isStrict d = not (isLazy d)
 104
 105 isPrim :: Demand -> Bool
 106 isPrim WwPrim = True
 107 isPrim _      = False
 108 \end{code}
 109
 110
 111 %************************************************************************
 112 %*                                                                      *
 113 \subsection{Instances}
 114 %*                                                                      *
 115 %************************************************************************
 116
 117
 118 \begin{code}
 119 pprDemands :: [Demand] -> Bool -> SDoc
 120 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
 121                        where
 122                          pp_bot | bot       = ptext SLIT("B")
 123                                 | otherwise = empty
 124
 125
 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))
 133                                       where
 134                                         ch = if wu then 'U' else 'u'
 135
 136 instance Outputable Demand where
 137     ppr (WwLazy False) = empty
 138     ppr other_demand   = ptext SLIT("__D") <+> pprDemand other_demand
 139
 140 instance Show Demand where
 141     showsPrec p d = showsPrecSDoc p (ppr d)
 142
 143 -- Reading demands is done in Lex.lhs
 144 \end{code}
 145
 146
 147 %************************************************************************
 148 %*                                                                      *
 149 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
 150 %*                                                                      *
 151 %************************************************************************
 152
 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
 156 unboxed types).
 157
 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.
 161
 162 Note that the existence of a worker function is now denoted by the Id's
 163 workerInfo field.
 164
 165 \begin{code}
 166 data StrictnessInfo
 167   = NoStrictnessInfo
 168
 169   | StrictnessInfo [Demand]     -- Demands on the arguments.
 170
 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
 176   deriving( Eq )
 177
 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.
 184
 185 seqStrictnessInfo :: StrictnessInfo -> ()
 186 seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
 187 seqStrictnessInfo _                     = ()
 188 \end{code}
 189
 190 \begin{code}
 191 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
 192
 193 mkStrictnessInfo (xs, is_bot)
 194   | all totally_boring xs && not is_bot = NoStrictnessInfo              -- Uninteresting
 195   | otherwise                           = StrictnessInfo xs is_bot
 196   where
 197     totally_boring (WwLazy False) = True
 198     totally_boring _              = False
 199
 200 noStrictnessInfo :: StrictnessInfo
 201 noStrictnessInfo = NoStrictnessInfo
 202
 203 isBottomingStrictness :: StrictnessInfo -> Bool
 204 isBottomingStrictness (StrictnessInfo _ bot) = bot
 205 isBottomingStrictness NoStrictnessInfo       = False
 206
 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
 211
 212 ppStrictnessInfo :: StrictnessInfo -> SDoc
 213 ppStrictnessInfo NoStrictnessInfo                  = empty
 214 ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
 215 \end{code}
 216
 217 \begin{code}
 218 #endif /* OLD_STRICTNESS */
 219 \end{code}