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