ghc/compiler/basicTypes/Demand.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   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,
  12
  13         showDemands
  14      ) where
  15
  16 #include "HsVersions.h"
  17
  18 import BasicTypes       ( NewOrData(..) )
  19 import Outputable
  20 import Util             ( panic )
  21 \end{code}
  22
  23
  24 %************************************************************************
  25 %*                                                                      *
  26 \subsection{The @Demand@ data type}
  27 %*                                                                      *
  28 %************************************************************************
  29
  30 \begin{code}
  31 data Demand
  32   = WwLazy              -- Argument is lazy as far as we know
  33         MaybeAbsent     -- (does not imply worker's existence [etc]).
  34                         -- If MaybeAbsent == True, then it is
  35                         -- *definitely* lazy.  (NB: Absence implies
  36                         -- a worker...)
  37
  38   | WwStrict            -- Argument is strict but that's all we know
  39                         -- (does not imply worker's existence or any
  40                         -- calling-convention magic)
  41
  42   | WwUnpack            -- Argument is strict & a single-constructor type
  43         NewOrData
  44         Bool            -- True <=> wrapper unpacks it; False <=> doesn't
  45         [Demand]        -- Its constituent parts (whose StrictInfos
  46                         -- are in the list) should be passed
  47                         -- as arguments to the worker.
  48
  49   | WwPrim              -- Argument is of primitive type, therefore
  50                         -- strict; doesn't imply existence of a worker;
  51                         -- argument should be passed as is to worker.
  52
  53   | WwEnum              -- Argument is strict & an enumeration type;
  54                         -- an Int# representing the tag (start counting
  55                         -- at zero) should be passed to the worker.
  56   deriving( Eq )
  57
  58 type MaybeAbsent = Bool -- True <=> not even used
  59
  60 -- versions that don't worry about Absence:
  61 wwLazy      = WwLazy      False
  62 wwStrict    = WwStrict
  63 wwUnpackData xs = WwUnpack DataType False xs
  64 wwUnpackNew  x  = WwUnpack NewType  False [x]
  65 wwPrim      = WwPrim
  66 wwEnum      = WwEnum
  67 \end{code}
  68
  69
  70 %************************************************************************
  71 %*                                                                      *
  72 \subsection{Functions over @Demand@}
  73 %*                                                                      *
  74 %************************************************************************
  75
  76 \begin{code}
  77 isStrict :: Demand -> Bool
  78
  79 isStrict WwStrict       = True
  80 isStrict (WwUnpack DataType _ _) = True
  81 isStrict (WwUnpack NewType _ ds) = isStrict (head ds)
  82 isStrict WwPrim         = True
  83 isStrict WwEnum         = True
  84 isStrict _              = False
  85 \end{code}
  86
  87
  88 %************************************************************************
  89 %*                                                                      *
  90 \subsection{Instances}
  91 %*                                                                      *
  92 %************************************************************************
  93
  94 \begin{code}
  95 showDemands :: [Demand] -> String
  96 showDemands wrap_args = show_demands wrap_args ""
  97
  98
  99 #ifdef REALLY_HASKELL_1_3
 100
 101 instance Read Demand where
 102     readList str = read_em [] str
 103 instance Show Demand where
 104     showsPrec prec wrap rest = show_demand wrap rest
 105     showList wrap_args rest  = show_demands wrap_args rest
 106
 107 #else
 108
 109 instance Text Demand where
 110     readList str = read_em [] str
 111     showList wrap_args rest = show_demands wrap_args rest
 112
 113 #endif
 114
 115 read_em acc ('L' : xs)  = read_em (WwLazy   False : acc) xs
 116 read_em acc ('A' : xs)  = read_em (WwLazy   True  : acc) xs
 117 read_em acc ('S' : xs)  = read_em (WwStrict : acc) xs
 118 read_em acc ('P' : xs)  = read_em (WwPrim : acc) xs
 119 read_em acc ('E' : xs)  = read_em (WwEnum : acc) xs
 120 read_em acc (')' : xs)  = [(reverse acc, xs)]
 121 read_em acc ( 'U'  : '(' : xs) = do_unpack DataType True  acc xs
 122 read_em acc ( 'u'  : '(' : xs) = do_unpack DataType False acc xs
 123 read_em acc ( 'N'  : '(' : xs) = do_unpack NewType  True  acc xs
 124 read_em acc ( 'n'  : '(' : xs) = do_unpack NewType  False acc xs
 125 read_em acc rest        = [(reverse acc, rest)]
 126
 127 do_unpack new_or_data wrapper_unpacks acc xs
 128           = case (read_em [] xs) of
 129               [(stuff, rest)] -> read_em (WwUnpack new_or_data wrapper_unpacks stuff : acc) rest
 130               _ -> panic ("Demand.do_unpack:"++show acc++"::"++xs)
 131
 132 show_demands wrap_args rest
 133   = foldr show_demand rest wrap_args
 134
 135 show_demand (WwLazy False)        rest = 'L' : rest
 136 show_demand (WwLazy True)         rest = 'A' : rest
 137 show_demand WwStrict              rest = 'S' : rest
 138 show_demand WwPrim                rest = 'P' : rest
 139 show_demand WwEnum                rest = 'E' : rest
 140 show_demand (WwUnpack nd wu args) rest = ch:'(':showList args (')' : rest)
 141                                       where
 142                                         ch = case nd of
 143                                                 DataType | wu        -> 'U'
 144                                                          | otherwise -> 'u'
 145                                                 NewType  | wu        -> 'N'
 146                                                          | otherwise -> 'n'
 147
 148 instance Outputable Demand where
 149     ppr si = text (showList [si] "")
 150 \end{code}