compiler/basicTypes/Demand.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[Demand]{@Demand@: the amount of demand on a value}
   6
   7 \begin{code}
   8 {-# OPTIONS -w #-}
   9 -- The above warning supression flag is a temporary kludge.
  10 -- While working on this module you are encouraged to remove it and fix
  11 -- any warnings in the module. See
  12 --     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
  13 -- for details
  14
  15 #ifndef OLD_STRICTNESS
  16 module Demand () where
  17 #else
  18
  19 module Demand(
  20         Demand(..),
  21
  22         wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum,
  23         isStrict, isLazy, isPrim,
  24
  25         pprDemands, seqDemand, seqDemands,
  26
  27         StrictnessInfo(..),
  28         mkStrictnessInfo,
  29         noStrictnessInfo,
  30         ppStrictnessInfo, seqStrictnessInfo,
  31         isBottomingStrictness, appIsBottom,
  32
  33      ) where
  34
  35 #include "HsVersions.h"
  36
  37 import Outputable
  38 import Util
  39 \end{code}
  40
  41
  42 %************************************************************************
  43 %*                                                                      *
  44 \subsection{The @Demand@ data type}
  45 %*                                                                      *
  46 %************************************************************************
  47
  48 \begin{code}
  49 data Demand
  50   = WwLazy              -- Argument is lazy as far as we know
  51         MaybeAbsent     -- (does not imply worker's existence [etc]).
  52                         -- If MaybeAbsent == True, then it is
  53                         --  *definitely* lazy.  (NB: Absence implies
  54                         -- a worker...)
  55
  56   | WwStrict            -- Argument is strict but that's all we know
  57                         -- (does not imply worker's existence or any
  58                         -- calling-convention magic)
  59
  60   | WwUnpack            -- Argument is strict & a single-constructor type
  61         Bool            -- True <=> wrapper unpacks it; False <=> doesn't
  62         [Demand]        -- Its constituent parts (whose StrictInfos
  63                         -- are in the list) should be passed
  64                         -- as arguments to the worker.
  65
  66   | WwPrim              -- Argument is of primitive type, therefore
  67                         -- strict; doesn't imply existence of a worker;
  68                         -- argument should be passed as is to worker.
  69
  70   | WwEnum              -- Argument is strict & an enumeration type;
  71                         -- an Int# representing the tag (start counting
  72                         -- at zero) should be passed to the worker.
  73   deriving( Eq )
  74
  75 type MaybeAbsent = Bool -- True <=> not even used
  76
  77 -- versions that don't worry about Absence:
  78 wwLazy      = WwLazy      False
  79 wwStrict    = WwStrict
  80 wwUnpack xs = WwUnpack False xs
  81 wwPrim      = WwPrim
  82 wwEnum      = WwEnum
  83
  84 seqDemand :: Demand -> ()
  85 seqDemand (WwLazy a)      = a `seq` ()
  86 seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
  87 seqDemand other           = ()
  88
  89 seqDemands [] = ()
  90 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
  91 \end{code}
  92
  93
  94 %************************************************************************
  95 %*                                                                      *
  96 \subsection{Functions over @Demand@}
  97 %*                                                                      *
  98 %************************************************************************
  99
 100 \begin{code}
 101 isLazy :: Demand -> Bool
 102 isLazy (WwLazy _) = True
 103 isLazy _          = False
 104
 105 isStrict :: Demand -> Bool
 106 isStrict d = not (isLazy d)
 107
 108 isPrim :: Demand -> Bool
 109 isPrim WwPrim = True
 110 isPrim other  = False
 111 \end{code}
 112
 113
 114 %************************************************************************
 115 %*                                                                      *
 116 \subsection{Instances}
 117 %*                                                                      *
 118 %************************************************************************
 119
 120
 121 \begin{code}
 122 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
 123                        where
 124                          pp_bot | bot       = ptext SLIT("B")
 125                                 | otherwise = empty
 126
 127
 128 pprDemand (WwLazy False)         = char 'L'
 129 pprDemand (WwLazy True)          = char 'A'
 130 pprDemand WwStrict               = char 'S'
 131 pprDemand WwPrim                 = char 'P'
 132 pprDemand WwEnum                 = char 'E'
 133 pprDemand (WwUnpack wu args)     = char ch <> parens (hcat (map pprDemand args))
 134                                       where
 135                                         ch = if wu then 'U' else 'u'
 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   deriving( Eq )
 178
 179         -- NOTA BENE: if the arg demands are, say, [S,L], this means that
 180         --      (f bot) is not necy bot, only (f bot x) is bot
 181         -- We simply cannot express accurately the strictness of a function
 182         -- like         f = \x -> case x of (a,b) -> \y -> ...
 183         -- The up-side is that we don't need to restrict the strictness info
 184         -- to the visible arity of the function.
 185
 186 seqStrictnessInfo :: StrictnessInfo -> ()
 187 seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
 188 seqStrictnessInfo other                 = ()
 189 \end{code}
 190
 191 \begin{code}
 192 mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
 193
 194 mkStrictnessInfo (xs, is_bot)
 195   | all totally_boring xs && not is_bot = NoStrictnessInfo              -- Uninteresting
 196   | otherwise                           = StrictnessInfo xs is_bot
 197   where
 198     totally_boring (WwLazy False) = True
 199     totally_boring other          = False
 200
 201 noStrictnessInfo = NoStrictnessInfo
 202
 203 isBottomingStrictness (StrictnessInfo _ bot) = bot
 204 isBottomingStrictness NoStrictnessInfo       = False
 205
 206 -- appIsBottom returns true if an application to n args would diverge
 207 appIsBottom (StrictnessInfo ds bot)   n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
 208 appIsBottom  NoStrictnessInfo         n = False
 209
 210 ppStrictnessInfo NoStrictnessInfo                  = empty
 211 ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
 212 \end{code}
 213
 214 \begin{code}
 215 #endif /* OLD_STRICTNESS */
 216 \end{code}