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