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   = False       -- NB: we treat only lifted types as strict.
  82                                 -- Why is this important?  Mostly it doesn't matter
  83                                 -- but it saves a test for lifted-ness in SimplUtils.etaCoreExpr
  84 isStrict _        = False
  85 \end{code}
  86
  87 \begin{code}
  88 isLazy :: Demand -> Bool
  89 isLazy (WwLazy False) = True    -- NB "Absent" args do *not* count!
  90 isLazy _              = False   -- (as they imply a worker)
  91 \end{code}
  92
  93
  94 %************************************************************************
  95 %*                                                                      *
  96 \subsection{Instances}
  97 %*                                                                      *
  98 %************************************************************************
  99
 100 \begin{code}
 101 #ifdef REALLY_HASKELL_1_3
 102
 103 instance Read Demand where
 104     readList str = read_em [] str
 105
 106 instance Show Demand where
 107     showsPrec p d = showsPrecSDoc p (ppr d)
 108
 109 #else
 110
 111 instance Text Demand where
 112     readList str  = read_em [] str
 113     showsPrec p d = showsPrecSDoc p (ppr d)
 114 #endif
 115
 116 read_em acc ('L' : xs)  = read_em (WwLazy   False : acc) xs
 117 read_em acc ('A' : xs)  = read_em (WwLazy   True  : acc) xs
 118 read_em acc ('S' : xs)  = read_em (WwStrict : acc) xs
 119 read_em acc ('P' : xs)  = read_em (WwPrim : acc) xs
 120 read_em acc ('E' : xs)  = read_em (WwEnum : acc) xs
 121 read_em acc (')' : xs)  = [(reverse acc, xs)]
 122 read_em acc ( 'U'  : '(' : xs) = do_unpack DataType True  acc xs
 123 read_em acc ( 'u'  : '(' : xs) = do_unpack DataType False acc xs
 124 read_em acc ( 'N'  : '(' : xs) = do_unpack NewType  True  acc xs
 125 read_em acc ( 'n'  : '(' : xs) = do_unpack NewType  False acc xs
 126 read_em acc rest        = [(reverse acc, rest)]
 127
 128 do_unpack new_or_data wrapper_unpacks acc xs
 129           = case (read_em [] xs) of
 130               [(stuff, rest)] -> read_em (WwUnpack new_or_data wrapper_unpacks stuff : acc) rest
 131               _ -> pprPanic "Demand.do_unpack:" (ppr acc <+> text ("::"++xs))
 132
 133
 134 pprDemands demands = hcat (map pprDemand demands)
 135
 136 pprDemand (WwLazy False)         = char 'L'
 137 pprDemand (WwLazy True)          = char 'A'
 138 pprDemand WwStrict               = char 'S'
 139 pprDemand WwPrim                 = char 'P'
 140 pprDemand WwEnum                 = char 'E'
 141 pprDemand (WwUnpack nd wu args)  = char ch <> parens (pprDemands args)
 142                                       where
 143                                         ch = case nd of
 144                                                 DataType | wu        -> 'U'
 145                                                          | otherwise -> 'u'
 146                                                 NewType  | wu        -> 'N'
 147                                                          | otherwise -> 'n'
 148
 149 instance Outputable Demand where
 150     ppr (WwLazy False) = empty
 151     ppr other_demand   = ptext SLIT("__D") <+> pprDemand other_demand
 152 \end{code}