compiler/basicTypes/Demand.lhs

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