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      = WwLazy      False
  72 wwStrict    = WwStrict
  73 wwUnpack xs = WwUnpack False xs
  74 wwPrim      = WwPrim
  75 wwEnum      = WwEnum
  76
  77 seqDemand :: Demand -> ()
  78 seqDemand (WwLazy a)      = a `seq` ()
  79 seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
  80 seqDemand other           = ()
  81
  82 seqDemands [] = ()
  83 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
  84 \end{code}
  85
  86
  87 %************************************************************************
  88 %*                                                                      *
  89 \subsection{Functions over @Demand@}
  90 %*                                                                      *
  91 %************************************************************************
  92
  93 \begin{code}
  94 isLazy :: Demand -> Bool
  95 isLazy (WwLazy _) = True
  96 isLazy _          = False
  97
  98 isStrict :: Demand -> Bool
  99 isStrict d = not (isLazy d)
 100
 101 isPrim :: Demand -> Bool
 102 isPrim WwPrim = True
 103 isPrim other  = False
 104 \end{code}
 105
 106
 107 %************************************************************************
 108 %*                                                                      *
 109 \subsection{Instances}
 110 %*                                                                      *
 111 %************************************************************************
 112
 113
 114 \begin{code}
 115 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
 116                        where
 117                          pp_bot | bot       = ptext SLIT("B")
 118                                 | otherwise = empty
 119
 120
 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))
 127                                       where
 128                                         ch = if wu then 'U' else 'u'
 129
 130 instance Outputable Demand where
 131     ppr (WwLazy False) = empty
 132     ppr other_demand   = ptext SLIT("__D") <+> pprDemand other_demand
 133
 134 instance Show Demand where
 135     showsPrec p d = showsPrecSDoc p (ppr d)
 136
 137 -- Reading demands is done in Lex.lhs
 138 \end{code}
 139
 140
 141 %************************************************************************
 142 %*                                                                      *
 143 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
 144 %*                                                                      *
 145 %************************************************************************
 146
 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
 150 unboxed types).
 151
 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.
 155
 156 Note that the existence of a worker function is now denoted by the Id's
 157 workerInfo field.
 158
 159 \begin{code}
 160 data StrictnessInfo
 161   = NoStrictnessInfo
 162
 163   | StrictnessInfo [Demand]     -- Demands on the arguments.
 164
 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
 170   deriving( Eq )
 171
 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.
 178
 179 seqStrictnessInfo :: StrictnessInfo -> ()
 180 seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
 181 seqStrictnessInfo other                 = ()
 182 \end{code}
 183
 184 \begin{code}
 185 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
 186
 187 mkStrictnessInfo (xs, is_bot)
 188   | all totally_boring xs && not is_bot = NoStrictnessInfo              -- Uninteresting
 189   | otherwise                           = StrictnessInfo xs is_bot
 190   where
 191     totally_boring (WwLazy False) = True
 192     totally_boring other          = False
 193
 194 noStrictnessInfo = NoStrictnessInfo
 195
 196 isBottomingStrictness (StrictnessInfo _ bot) = bot
 197 isBottomingStrictness NoStrictnessInfo       = False
 198
 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
 202
 203 ppStrictnessInfo NoStrictnessInfo                  = empty
 204 ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
 205 \end{code}
 206
 207 \begin{code}
 208 #endif /* OLD_STRICTNESS */
 209 \end{code}