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 #include "HsVersions.h"
   8
   9 module Demand(
  10         Demand(..),
  11
  12         wwLazy, wwStrict, wwUnpackData, wwUnpackNew, wwPrim, wwEnum,
  13         isStrict,
  14
  15         showDemands
  16      ) where
  17
  18 import BasicTypes       ( NewOrData(..) )
  19 import Outputable
  20 import Pretty           ( Doc, text )
  21 import Util             ( panic )
  22 \end{code}
  23
  24
  25 %************************************************************************
  26 %*                                                                      *
  27 \subsection{The @Demand@ data type}
  28 %*                                                                      *
  29 %************************************************************************
  30
  31 \begin{code}
  32 data Demand
  33   = WwLazy              -- Argument is lazy as far as we know
  34         MaybeAbsent     -- (does not imply worker's existence [etc]).
  35                         -- If MaybeAbsent == True, then it is
  36                         -- *definitely* lazy.  (NB: Absence implies
  37                         -- a worker...)
  38
  39   | WwStrict            -- Argument is strict but that's all we know
  40                         -- (does not imply worker's existence or any
  41                         -- calling-convention magic)
  42
  43   | WwUnpack            -- Argument is strict & a single-constructor type
  44         NewOrData
  45         Bool            -- True <=> wrapper unpacks it; False <=> doesn't
  46         [Demand]        -- Its constituent parts (whose StrictInfos
  47                         -- are in the list) should be passed
  48                         -- as arguments to the worker.
  49
  50   | WwPrim              -- Argument is of primitive type, therefore
  51                         -- strict; doesn't imply existence of a worker;
  52                         -- argument should be passed as is to worker.
  53
  54   | WwEnum              -- Argument is strict & an enumeration type;
  55                         -- an Int# representing the tag (start counting
  56                         -- at zero) should be passed to the worker.
  57   deriving( Eq )
  58
  59 type MaybeAbsent = Bool -- True <=> not even used
  60
  61 -- versions that don't worry about Absence:
  62 wwLazy      = WwLazy      False
  63 wwStrict    = WwStrict
  64 wwUnpackData xs = WwUnpack DataType False xs
  65 wwUnpackNew  x  = WwUnpack NewType  False [x]
  66 wwPrim      = WwPrim
  67 wwEnum      = WwEnum
  68 \end{code}
  69
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection{Functions over @Demand@}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 \begin{code}
  78 isStrict :: Demand -> Bool
  79
  80 isStrict WwStrict       = True
  81 isStrict (WwUnpack DataType _ _) = True
  82 isStrict (WwUnpack NewType _ ds) = isStrict (head ds)
  83 isStrict WwPrim         = True
  84 isStrict WwEnum         = True
  85 isStrict _              = False
  86 \end{code}
  87
  88
  89 %************************************************************************
  90 %*                                                                      *
  91 \subsection{Instances}
  92 %*                                                                      *
  93 %************************************************************************
  94
  95 \begin{code}
  96 showDemands :: [Demand] -> String
  97 showDemands wrap_args = show_demands wrap_args ""
  98
  99
 100 #ifdef REALLY_HASKELL_1_3
 101
 102 instance Read Demand where
 103     readList str = read_em [] str
 104 instance Show Demand where
 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 show1 rest wrap_args
 134   where
 135         show1 (WwLazy False)     rest = 'L' : rest
 136         show1 (WwLazy True)      rest = 'A' : rest
 137         show1 WwStrict           rest = 'S' : rest
 138         show1 WwPrim             rest = 'P' : rest
 139         show1 WwEnum             rest = 'E' : rest
 140         show1 (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 sty si = text (showList [si] "")
 150 \end{code}
 151
 152
 153