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
  21         StrictnessMark(..), isMarkedUnboxed, isMarkedStrict
  22      ) where
  23
  24 #include "HsVersions.h"
  25
  26 import BasicTypes       ( NewOrData(..) )
  27 import Outputable
  28 \end{code}
  29
  30
  31 %************************************************************************
  32 %*                                                                      *
  33 \subsection{The @Demand@ data type}
  34 %*                                                                      *
  35 %************************************************************************
  36
  37 \begin{code}
  38 data Demand
  39   = WwLazy              -- Argument is lazy as far as we know
  40         MaybeAbsent     -- (does not imply worker's existence [etc]).
  41                         -- If MaybeAbsent == True, then it is
  42                         -- *definitely* lazy.  (NB: Absence implies
  43                         -- a worker...)
  44
  45   | WwStrict            -- Argument is strict but that's all we know
  46                         -- (does not imply worker's existence or any
  47                         -- calling-convention magic)
  48
  49   | WwUnpack            -- Argument is strict & a single-constructor type
  50         NewOrData
  51         Bool            -- True <=> wrapper unpacks it; False <=> doesn't
  52         [Demand]        -- Its constituent parts (whose StrictInfos
  53                         -- are in the list) should be passed
  54                         -- as arguments to the worker.
  55
  56   | WwPrim              -- Argument is of primitive type, therefore
  57                         -- strict; doesn't imply existence of a worker;
  58                         -- argument should be passed as is to worker.
  59
  60   | WwEnum              -- Argument is strict & an enumeration type;
  61                         -- an Int# representing the tag (start counting
  62                         -- at zero) should be passed to the worker.
  63   deriving( Eq )
  64
  65 type MaybeAbsent = Bool -- True <=> not even used
  66
  67 -- versions that don't worry about Absence:
  68 wwLazy      = WwLazy      False
  69 wwStrict    = WwStrict
  70 wwUnpackData xs = WwUnpack DataType False xs
  71 wwUnpackNew  x  = ASSERT( isStrict x)   -- Invariant
  72                   WwUnpack NewType False [x]
  73 wwPrim      = WwPrim
  74 wwEnum      = WwEnum
  75
  76 seqDemand :: Demand -> ()
  77 seqDemand (WwLazy a)         = a `seq` ()
  78 seqDemand (WwUnpack nd b ds) = nd `seq` 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   -- Even a demand of (WwUnpack NewType _ _) is strict
  95   -- We don't create such a thing unless the demand inside is strict
  96 isLazy (WwLazy _) = True
  97 isLazy _          = False
  98
  99 isStrict :: Demand -> Bool
 100 isStrict d = not (isLazy d)
 101
 102 isPrim :: Demand -> Bool
 103 isPrim WwPrim = True
 104 isPrim other  = False
 105 \end{code}
 106
 107
 108 %************************************************************************
 109 %*                                                                      *
 110 \subsection{Instances}
 111 %*                                                                      *
 112 %************************************************************************
 113
 114
 115 \begin{code}
 116 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
 117                        where
 118                          pp_bot | bot       = ptext SLIT("B")
 119                                 | otherwise = empty
 120
 121
 122 pprDemand (WwLazy False)         = char 'L'
 123 pprDemand (WwLazy True)          = char 'A'
 124 pprDemand WwStrict               = char 'S'
 125 pprDemand WwPrim                 = char 'P'
 126 pprDemand WwEnum                 = char 'E'
 127 pprDemand (WwUnpack nd wu args)  = char ch <> parens (hcat (map pprDemand args))
 128                                       where
 129                                         ch = case nd of
 130                                                 DataType | wu        -> 'U'
 131                                                          | otherwise -> 'u'
 132                                                 NewType  | wu        -> 'N'
 133                                                          | otherwise -> 'n'
 134
 135 instance Outputable Demand where
 136     ppr (WwLazy False) = empty
 137     ppr other_demand   = ptext SLIT("__D") <+> pprDemand other_demand
 138
 139 instance Show Demand where
 140     showsPrec p d = showsPrecSDoc p (ppr d)
 141
 142 -- Reading demands is done in Lex.lhs
 143 \end{code}
 144
 145
 146 %************************************************************************
 147 %*                                                                      *
 148 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
 149 %*                                                                      *
 150 %************************************************************************
 151
 152 We specify the strictness of a function by giving information about
 153 each of the ``wrapper's'' arguments (see the description about
 154 worker/wrapper-style transformations in the PJ/Launchbury paper on
 155 unboxed types).
 156
 157 The list of @Demands@ specifies: (a)~the strictness properties of a
 158 function's arguments; and (b)~the type signature of that worker (if it
 159 exists); i.e. its calling convention.
 160
 161 Note that the existence of a worker function is now denoted by the Id's
 162 workerInfo field.
 163
 164 \begin{code}
 165 data StrictnessInfo
 166   = NoStrictnessInfo
 167
 168   | StrictnessInfo [Demand]     -- Demands on the arguments.
 169
 170                    Bool         -- True <=> the function diverges regardless of its arguments
 171                                 -- Useful for "error" and other disguised variants thereof.
 172                                 -- BUT NB: f = \x y. error "urk"
 173                                 --         will have info  SI [SS] True
 174                                 -- but still (f) and (f 2) are not bot; only (f 3 2) is bot
 175   deriving( Eq )
 176
 177         -- NOTA BENE: if the arg demands are, say, [S,L], this means that
 178         --      (f bot) is not necy bot, only (f bot x) is bot
 179         -- We simply cannot express accurately the strictness of a function
 180         -- like         f = \x -> case x of (a,b) -> \y -> ...
 181         -- The up-side is that we don't need to restrict the strictness info
 182         -- to the visible arity of the function.
 183
 184 seqStrictnessInfo :: StrictnessInfo -> ()
 185 seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
 186 seqStrictnessInfo other                 = ()
 187 \end{code}
 188
 189 \begin{code}
 190 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
 191
 192 mkStrictnessInfo (xs, is_bot)
 193   | all totally_boring xs && not is_bot = NoStrictnessInfo              -- Uninteresting
 194   | otherwise                           = StrictnessInfo xs is_bot
 195   where
 196     totally_boring (WwLazy False) = True
 197     totally_boring other          = False
 198
 199 noStrictnessInfo = NoStrictnessInfo
 200
 201 isBottomingStrictness (StrictnessInfo _ bot) = bot
 202 isBottomingStrictness NoStrictnessInfo       = False
 203
 204 -- appIsBottom returns true if an application to n args would diverge
 205 appIsBottom (StrictnessInfo ds bot)   n = bot && (n >= length ds)
 206 appIsBottom  NoStrictnessInfo         n = False
 207
 208 ppStrictnessInfo NoStrictnessInfo                  = empty
 209 ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
 210 \end{code}
 211
 212
 213 %************************************************************************
 214 %*                                                                      *
 215 \subsection{Strictness indication}
 216 %*                                                                      *
 217 %************************************************************************
 218
 219 The strictness annotations on types in data type declarations
 220 e.g.    data T = MkT !Int !(Bool,Bool)
 221
 222 \begin{code}
 223 data StrictnessMark
 224    = MarkedUserStrict   -- "!"  in a source decl
 225    | MarkedStrict       -- "!"  in an interface decl: strict but not unboxed
 226    | MarkedUnboxed      -- "!!" in an interface decl: unboxed
 227    | NotMarkedStrict    -- No annotation at all
 228    deriving( Eq )
 229
 230 isMarkedUnboxed MarkedUnboxed = True
 231 isMarkedUnboxed other         = False
 232
 233 isMarkedStrict NotMarkedStrict = False
 234 isMarkedStrict other           = True   -- All others are strict
 235
 236 instance Outputable StrictnessMark where
 237   ppr MarkedUserStrict = ptext SLIT("!u")
 238   ppr MarkedStrict     = ptext SLIT("!")
 239   ppr MarkedUnboxed    = ptext SLIT("! !")
 240   ppr NotMarkedStrict  = empty
 241 \end{code}
 242
 243