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
  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 \end{code}
  67
  68
  69 %************************************************************************
  70 %*                                                                      *
  71 \subsection{Functions over @Demand@}
  72 %*                                                                      *
  73 %************************************************************************
  74
  75 \begin{code}
  76 isStrict :: Demand -> Bool
  77 isStrict (WwUnpack NewType _ ds) = isStrict (head ds)
  78 isStrict (WwUnpack other _ _)    = True
  79 isStrict WwStrict = True
  80 isStrict WwEnum   = True
  81 isStrict WwPrim   = True
  82 isStrict _        = False
  83
  84 isPrim :: Demand -> Bool
  85 isPrim WwPrim = True
  86 isPrim other  = False
  87 \end{code}
  88
  89 \begin{code}
  90 isLazy :: Demand -> Bool
  91 isLazy (WwLazy False) = True    -- NB "Absent" args do *not* count!
  92 isLazy _              = False   -- (as they imply a worker)
  93 \end{code}
  94
  95
  96 %************************************************************************
  97 %*                                                                      *
  98 \subsection{Instances}
  99 %*                                                                      *
 100 %************************************************************************
 101
 102
 103 \begin{code}
 104 pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
 105                        where
 106                          pp_bot | bot       = ptext SLIT("B")
 107                                 | otherwise = empty
 108
 109
 110 pprDemand (WwLazy False)         = char 'L'
 111 pprDemand (WwLazy True)          = char 'A'
 112 pprDemand WwStrict               = char 'S'
 113 pprDemand WwPrim                 = char 'P'
 114 pprDemand WwEnum                 = char 'E'
 115 pprDemand (WwUnpack nd wu args)  = char ch <> parens (hcat (map pprDemand args))
 116                                       where
 117                                         ch = case nd of
 118                                                 DataType | wu        -> 'U'
 119                                                          | otherwise -> 'u'
 120                                                 NewType  | wu        -> 'N'
 121                                                          | otherwise -> 'n'
 122
 123 instance Outputable Demand where
 124     ppr (WwLazy False) = empty
 125     ppr other_demand   = ptext SLIT("__D") <+> pprDemand other_demand
 126
 127 instance Show Demand where
 128     showsPrec p d = showsPrecSDoc p (ppr d)
 129 \end{code}
 130
 131
 132 \begin{code}
 133 {-      ------------------- OMITTED NOW -------------------------------
 134         -- Reading demands is done in Lex.lhs
 135         -- Also note that the (old) code here doesn't take proper
 136         -- account of the 'B' suffix for bottoming functions
 137
 138 #ifdef REALLY_HASKELL_1_3
 139
 140 instance Read Demand where
 141     readList str = read_em [] str
 142
 143 instance Show Demand where
 144     showsPrec p d = showsPrecSDoc p (ppr d)
 145
 146 #else
 147
 148 instance Text Demand where
 149     readList str  = read_em [] str
 150     showsPrec p d = showsPrecSDoc p (ppr d)
 151 #endif
 152
 153 readDemands :: String ->
 154
 155 read_em acc ('L' : xs)  = read_em (WwLazy   False : acc) xs
 156 read_em acc ('A' : xs)  = read_em (WwLazy   True  : acc) xs
 157 read_em acc ('S' : xs)  = read_em (WwStrict : acc) xs
 158 read_em acc ('P' : xs)  = read_em (WwPrim : acc) xs
 159 read_em acc ('E' : xs)  = read_em (WwEnum : acc) xs
 160 read_em acc (')' : xs)  = [(reverse acc, xs)]
 161 read_em acc ( 'U'  : '(' : xs) = do_unpack DataType True  acc xs
 162 read_em acc ( 'u'  : '(' : xs) = do_unpack DataType False acc xs
 163 read_em acc ( 'N'  : '(' : xs) = do_unpack NewType  True  acc xs
 164 read_em acc ( 'n'  : '(' : xs) = do_unpack NewType  False acc xs
 165 read_em acc rest        = [(reverse acc, rest)]
 166
 167 do_unpack new_or_data wrapper_unpacks acc xs
 168           = case (read_em [] xs) of
 169               [(stuff, rest)] -> read_em (WwUnpack new_or_data wrapper_unpacks stuff : acc) rest
 170               _ -> pprPanic "Demand.do_unpack:" (ppr acc <+> dcolon <> text xs)
 171
 172 -------------------- END OF OMISSION ------------------------------  -}
 173 \end{code}
 174