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