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 where
  10
  11 import PprStyle         ( PprStyle )
  12 import Outputable
  13 import Pretty           ( Doc, text )
  14 import Util             ( panic )
  15 \end{code}
  16
  17
  18 %************************************************************************
  19 %*                                                                      *
  20 \subsection{The @Demand@ data type}
  21 %*                                                                      *
  22 %************************************************************************
  23
  24 \begin{code}
  25 data Demand
  26   = WwLazy              -- Argument is lazy as far as we know
  27         MaybeAbsent     -- (does not imply worker's existence [etc]).
  28                         -- If MaybeAbsent == True, then it is
  29                         -- *definitely* lazy.  (NB: Absence implies
  30                         -- a worker...)
  31
  32   | WwStrict            -- Argument is strict but that's all we know
  33                         -- (does not imply worker's existence or any
  34                         -- calling-convention magic)
  35
  36   | WwUnpack            -- Argument is strict & a single-constructor
  37         Bool            -- True <=> wrapper unpacks it; False <=> doesn't
  38         [Demand]        -- type; its constituent parts (whose StrictInfos
  39                         -- are in the list) should be passed
  40                         -- as arguments to the worker.
  41
  42   | WwPrim              -- Argument is of primitive type, therefore
  43                         -- strict; doesn't imply existence of a worker;
  44                         -- argument should be passed as is to worker.
  45
  46   | WwEnum              -- Argument is strict & an enumeration type;
  47                         -- an Int# representing the tag (start counting
  48                         -- at zero) should be passed to the worker.
  49   deriving (Eq, Ord)
  50       -- we need Eq/Ord to cross-chk update infos in interfaces
  51
  52 type MaybeAbsent = Bool -- True <=> not even used
  53
  54 -- versions that don't worry about Absence:
  55 wwLazy      = WwLazy      False
  56 wwStrict    = WwStrict
  57 wwUnpack xs = WwUnpack False xs
  58 wwPrim      = WwPrim
  59 wwEnum      = WwEnum
  60 \end{code}
  61
  62
  63 %************************************************************************
  64 %*                                                                      *
  65 \subsection{Functions over @Demand@}
  66 %*                                                                      *
  67 %************************************************************************
  68
  69 \begin{code}
  70 isStrict :: Demand -> Bool
  71
  72 isStrict WwStrict       = True
  73 isStrict (WwUnpack _ _) = True
  74 isStrict WwPrim         = True
  75 isStrict WwEnum         = True
  76 isStrict _              = False
  77 \end{code}
  78
  79
  80 %************************************************************************
  81 %*                                                                      *
  82 \subsection{Instances}
  83 %*                                                                      *
  84 %************************************************************************
  85
  86 \begin{code}
  87 #ifdef REALLY_HASKELL_1_3
  88 instance Read Demand where
  89 #else
  90 instance Text Demand where
  91 #endif
  92     readList str = read_em [{-acc-}] str
  93       where
  94         read_em acc ('L' : xs)  = read_em (WwLazy   False : acc) xs
  95         read_em acc ('A' : xs)  = read_em (WwLazy   True  : acc) xs
  96         read_em acc ('S' : xs)  = read_em (WwStrict : acc) xs
  97         read_em acc ('P' : xs)  = read_em (WwPrim : acc) xs
  98         read_em acc ('E' : xs)  = read_em (WwEnum : acc) xs
  99
 100         read_em acc (')' : xs)  = [(reverse acc, xs)]
 101         read_em acc ( 'U'  : '(' : xs) = do_unpack True  acc xs
 102         read_em acc ( 'u'  : '(' : xs) = do_unpack False acc xs
 103
 104         read_em acc rest        = [(reverse acc, rest)]
 105
 106         do_unpack wrapper_unpacks acc xs
 107           = case (read_em [] xs) of
 108               [(stuff, rest)] -> read_em (WwUnpack wrapper_unpacks stuff : acc) rest
 109               _ -> panic ("Text.Demand:"++str++"::"++xs)
 110
 111
 112 #ifdef REALLY_HASKELL_1_3
 113 instance Show Demand where
 114 #endif
 115     showList wrap_args rest = foldr show1 rest wrap_args
 116       where
 117         show1 (WwLazy False)     rest = 'L' : rest
 118         show1 (WwLazy True)      rest = 'A' : rest
 119         show1 WwStrict           rest = 'S' : rest
 120         show1 WwPrim             rest = 'P' : rest
 121         show1 WwEnum             rest = 'E' : rest
 122         show1 (WwUnpack wu args) rest = ch ++ "(" ++ showList args (')' : rest)
 123                                       where
 124                                         ch = if wu then "U" else "u"
 125
 126 instance Outputable Demand where
 127     ppr sty si = text (showList [si] "")
 128 \end{code}
 129
 130
 131