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  = WwUnpack NewType  False [x]
  70 wwPrim      = WwPrim
  71 wwEnum      = WwEnum
  72
  73 seqDemand :: Demand -> ()
  74 seqDemand (WwLazy a)         = a `seq` ()
  75 seqDemand (WwUnpack nd b ds) = nd `seq` b `seq` seqDemands ds
  76 seqDemand other              = ()
  77
  78 seqDemands [] = ()
  79 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
  80 \end{code}
  81
  82
  83 %************************************************************************
  84 %*                                                                      *
  85 \subsection{Functions over @Demand@}
  86 %*                                                                      *
  87 %************************************************************************
  88
  89 \begin{code}
  90 isStrict :: Demand -> Bool
  91 isStrict (WwUnpack NewType _ ds) = isStrict (head ds)
  92 isStrict (WwUnpack other _ _)    = True
  93 isStrict WwStrict = True
  94 isStrict WwEnum   = True
  95 isStrict WwPrim   = True
  96 isStrict _        = False
  97
  98 isPrim :: Demand -> Bool
  99 isPrim WwPrim = True
 100 isPrim other  = False
 101 \end{code}
 102
 103 \begin{code}
 104 isLazy :: Demand -> Bool
 105 isLazy (WwLazy False) = True    -- NB "Absent" args do *not* count!
 106 isLazy _              = False   -- (as they imply a worker)
 107 \end{code}
 108
 109
 110 %************************************************************************
 111 %*                                                                      *
 112 \subsection{Instances}
 113 %*                                                                      *
 114 %************************************************************************
 115
 116
 117 \begin{code}
 118 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
 119                        where
 120                          pp_bot | bot       = ptext SLIT("B")
 121                                 | otherwise = empty
 122
 123
 124 pprDemand (WwLazy False)         = char 'L'
 125 pprDemand (WwLazy True)          = char 'A'
 126 pprDemand WwStrict               = char 'S'
 127 pprDemand WwPrim                 = char 'P'
 128 pprDemand WwEnum                 = char 'E'
 129 pprDemand (WwUnpack nd wu args)  = char ch <> parens (hcat (map pprDemand args))
 130                                       where
 131                                         ch = case nd of
 132                                                 DataType | wu        -> 'U'
 133                                                          | otherwise -> 'u'
 134                                                 NewType  | wu        -> 'N'
 135                                                          | otherwise -> 'n'
 136
 137 instance Outputable Demand where
 138     ppr (WwLazy False) = empty
 139     ppr other_demand   = ptext SLIT("__D") <+> pprDemand other_demand
 140
 141 instance Show Demand where
 142     showsPrec p d = showsPrecSDoc p (ppr d)
 143
 144 -- Reading demands is done in Lex.lhs
 145 \end{code}
 146
 147
 148 %************************************************************************
 149 %*                                                                      *
 150 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
 151 %*                                                                      *
 152 %************************************************************************
 153
 154 We specify the strictness of a function by giving information about
 155 each of the ``wrapper's'' arguments (see the description about
 156 worker/wrapper-style transformations in the PJ/Launchbury paper on
 157 unboxed types).
 158
 159 The list of @Demands@ specifies: (a)~the strictness properties of a
 160 function's arguments; and (b)~the type signature of that worker (if it
 161 exists); i.e. its calling convention.
 162
 163 Note that the existence of a worker function is now denoted by the Id's
 164 workerInfo field.
 165
 166 \begin{code}
 167 data StrictnessInfo
 168   = NoStrictnessInfo
 169
 170   | StrictnessInfo [Demand]     -- Demands on the arguments.
 171
 172                    Bool         -- True <=> the function diverges regardless of its arguments
 173                                 -- Useful for "error" and other disguised variants thereof.
 174                                 -- BUT NB: f = \x y. error "urk"
 175                                 --         will have info  SI [SS] True
 176                                 -- but still (f) and (f 2) are not bot; only (f 3 2) is bot
 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 other                 = ()
 188 \end{code}
 189
 190 \begin{code}
 191 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
 192
 193 mkStrictnessInfo (xs, is_bot)
 194   | all isLazy xs && not is_bot = NoStrictnessInfo              -- Uninteresting
 195   | otherwise                   = StrictnessInfo xs is_bot
 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)
 208   = hsep [ptext SLIT("__S"), pprDemands wrapper_args bot]
 209 \end{code}
 210