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      ) where
  15
  16 #include "HsVersions.h"
  17
  18 import BasicTypes       ( NewOrData(..) )
  19 import Outputable
  20 \end{code}
  21
  22
  23 %************************************************************************
  24 %*                                                                      *
  25 \subsection{The @Demand@ data type}
  26 %*                                                                      *
  27 %************************************************************************
  28
  29 \begin{code}
  30 data Demand
  31   = WwLazy              -- Argument is lazy as far as we know
  32         MaybeAbsent     -- (does not imply worker's existence [etc]).
  33                         -- If MaybeAbsent == True, then it is
  34                         -- *definitely* lazy.  (NB: Absence implies
  35                         -- a worker...)
  36
  37   | WwStrict            -- Argument is strict but that's all we know
  38                         -- (does not imply worker's existence or any
  39                         -- calling-convention magic)
  40
  41   | WwUnpack            -- Argument is strict & a single-constructor type
  42         NewOrData
  43         Bool            -- True <=> wrapper unpacks it; False <=> doesn't
  44         [Demand]        -- Its constituent parts (whose StrictInfos
  45                         -- are in the list) should be passed
  46                         -- as arguments to the worker.
  47
  48   | WwPrim              -- Argument is of primitive type, therefore
  49                         -- strict; doesn't imply existence of a worker;
  50                         -- argument should be passed as is to worker.
  51
  52   | WwEnum              -- Argument is strict & an enumeration type;
  53                         -- an Int# representing the tag (start counting
  54                         -- at zero) should be passed to the worker.
  55   deriving( Eq )
  56
  57 type MaybeAbsent = Bool -- True <=> not even used
  58
  59 -- versions that don't worry about Absence:
  60 wwLazy      = WwLazy      False
  61 wwStrict    = WwStrict
  62 wwUnpackData xs = WwUnpack DataType False xs
  63 wwUnpackNew  x  = WwUnpack NewType  False [x]
  64 wwPrim      = WwPrim
  65 wwEnum      = WwEnum
  66
  67 seqDemand :: Demand -> ()
  68 seqDemand (WwLazy a)         = a `seq` ()
  69 seqDemand (WwUnpack nd b ds) = nd `seq` b `seq` seqDemands ds
  70 seqDemand other              = ()
  71
  72 seqDemands [] = ()
  73 seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
  74 \end{code}
  75
  76
  77 %************************************************************************
  78 %*                                                                      *
  79 \subsection{Functions over @Demand@}
  80 %*                                                                      *
  81 %************************************************************************
  82
  83 \begin{code}
  84 isStrict :: Demand -> Bool
  85 isStrict (WwUnpack NewType _ ds) = isStrict (head ds)
  86 isStrict (WwUnpack other _ _)    = True
  87 isStrict WwStrict = True
  88 isStrict WwEnum   = True
  89 isStrict WwPrim   = True
  90 isStrict _        = False
  91
  92 isPrim :: Demand -> Bool
  93 isPrim WwPrim = True
  94 isPrim other  = False
  95 \end{code}
  96
  97 \begin{code}
  98 isLazy :: Demand -> Bool
  99 isLazy (WwLazy False) = True    -- NB "Absent" args do *not* count!
 100 isLazy _              = False   -- (as they imply a worker)
 101 \end{code}
 102
 103
 104 %************************************************************************
 105 %*                                                                      *
 106 \subsection{Instances}
 107 %*                                                                      *
 108 %************************************************************************
 109
 110
 111 \begin{code}
 112 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
 113                        where
 114                          pp_bot | bot       = ptext SLIT("B")
 115                                 | otherwise = empty
 116
 117
 118 pprDemand (WwLazy False)         = char 'L'
 119 pprDemand (WwLazy True)          = char 'A'
 120 pprDemand WwStrict               = char 'S'
 121 pprDemand WwPrim                 = char 'P'
 122 pprDemand WwEnum                 = char 'E'
 123 pprDemand (WwUnpack nd wu args)  = char ch <> parens (hcat (map pprDemand args))
 124                                       where
 125                                         ch = case nd of
 126                                                 DataType | wu        -> 'U'
 127                                                          | otherwise -> 'u'
 128                                                 NewType  | wu        -> 'N'
 129                                                          | otherwise -> 'n'
 130
 131 instance Outputable Demand where
 132     ppr (WwLazy False) = empty
 133     ppr other_demand   = ptext SLIT("__D") <+> pprDemand other_demand
 134
 135 instance Show Demand where
 136     showsPrec p d = showsPrecSDoc p (ppr d)
 137 \end{code}
 138
 139
 140 \begin{code}
 141 {-      ------------------- OMITTED NOW -------------------------------
 142         -- Reading demands is done in Lex.lhs
 143         -- Also note that the (old) code here doesn't take proper
 144         -- account of the 'B' suffix for bottoming functions
 145
 146 #ifdef REALLY_HASKELL_1_3
 147
 148 instance Read Demand where
 149     readList str = read_em [] str
 150
 151 instance Show Demand where
 152     showsPrec p d = showsPrecSDoc p (ppr d)
 153
 154 #else
 155
 156 instance Text Demand where
 157     readList str  = read_em [] str
 158     showsPrec p d = showsPrecSDoc p (ppr d)
 159 #endif
 160
 161 readDemands :: String ->
 162
 163 read_em acc ('L' : xs)  = read_em (WwLazy   False : acc) xs
 164 read_em acc ('A' : xs)  = read_em (WwLazy   True  : acc) xs
 165 read_em acc ('S' : xs)  = read_em (WwStrict : acc) xs
 166 read_em acc ('P' : xs)  = read_em (WwPrim : acc) xs
 167 read_em acc ('E' : xs)  = read_em (WwEnum : acc) xs
 168 read_em acc (')' : xs)  = [(reverse acc, xs)]
 169 read_em acc ( 'U'  : '(' : xs) = do_unpack DataType True  acc xs
 170 read_em acc ( 'u'  : '(' : xs) = do_unpack DataType False acc xs
 171 read_em acc ( 'N'  : '(' : xs) = do_unpack NewType  True  acc xs
 172 read_em acc ( 'n'  : '(' : xs) = do_unpack NewType  False acc xs
 173 read_em acc rest        = [(reverse acc, rest)]
 174
 175 do_unpack new_or_data wrapper_unpacks acc xs
 176           = case (read_em [] xs) of
 177               [(stuff, rest)] -> read_em (WwUnpack new_or_data wrapper_unpacks stuff : acc) rest
 178               _ -> pprPanic "Demand.do_unpack:" (ppr acc <+> dcolon <> text xs)
 179
 180 -------------------- END OF OMISSION ------------------------------  -}
 181 \end{code}
 182