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           ( SYN_IE(Pretty), PrettyRep, ppStr )
  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         [Demand]        -- type; its constituent parts (whose StrictInfos
  38                         -- are in the list) should be passed
  39                         -- as arguments to the worker.
  40
  41   | WwPrim              -- Argument is of primitive type, therefore
  42                         -- strict; doesn't imply existence of a worker;
  43                         -- argument should be passed as is to worker.
  44
  45   | WwEnum              -- Argument is strict & an enumeration type;
  46                         -- an Int# representing the tag (start counting
  47                         -- at zero) should be passed to the worker.
  48   deriving (Eq, Ord)
  49       -- we need Eq/Ord to cross-chk update infos in interfaces
  50
  51 type MaybeAbsent = Bool -- True <=> not even used
  52
  53 -- versions that don't worry about Absence:
  54 wwLazy      = WwLazy      False
  55 wwStrict    = WwStrict
  56 wwUnpack xs = WwUnpack xs
  57 wwPrim      = WwPrim
  58 wwEnum      = WwEnum
  59 \end{code}
  60
  61
  62 %************************************************************************
  63 %*                                                                      *
  64 \subsection{Functions over @Demand@}
  65 %*                                                                      *
  66 %************************************************************************
  67
  68 \begin{code}
  69 isStrict :: Demand -> Bool
  70
  71 isStrict WwStrict       = True
  72 isStrict (WwUnpack _)   = True
  73 isStrict WwPrim         = True
  74 isStrict WwEnum         = True
  75 isStrict _              = False
  76 \end{code}
  77
  78
  79 %************************************************************************
  80 %*                                                                      *
  81 \subsection{Instances}
  82 %*                                                                      *
  83 %************************************************************************
  84
  85 \begin{code}
  86 #ifdef REALLY_HASKELL_1_3
  87 instance Read Demand where
  88 #else
  89 instance Text Demand where
  90 #endif
  91     readList str = read_em [{-acc-}] str
  92       where
  93         read_em acc ('L' : xs)  = read_em (WwLazy   False : acc) xs
  94         read_em acc ('A' : xs)  = read_em (WwLazy   True  : acc) xs
  95         read_em acc ('S' : xs)  = read_em (WwStrict : acc) xs
  96         read_em acc ('P' : xs)  = read_em (WwPrim : acc) xs
  97         read_em acc ('E' : xs)  = read_em (WwEnum : acc) xs
  98
  99         read_em acc (')' : xs)  = [(reverse acc, xs)]
 100         read_em acc ( 'U'  : '(' : xs)
 101           = case (read_em [] xs) of
 102               [(stuff, rest)] -> read_em (WwUnpack stuff : acc) rest
 103               _ -> panic ("Text.Demand:"++str++"::"++xs)
 104
 105         read_em acc rest        = [(reverse acc, rest)]
 106
 107 #ifdef REALLY_HASKELL_1_3
 108 instance Show Demand where
 109 #endif
 110     showList wrap_args rest = foldr show1 rest wrap_args
 111       where
 112         show1 (WwLazy False)  rest = 'L' : rest
 113         show1 (WwLazy True)   rest = 'A' : rest
 114         show1 WwStrict        rest = 'S' : rest
 115         show1 WwPrim          rest = 'P' : rest
 116         show1 WwEnum          rest = 'E' : rest
 117         show1 (WwUnpack args) rest = "U(" ++ showList args (')' : rest)
 118
 119 instance Outputable Demand where
 120     ppr sty si = ppStr (showList [si] "")
 121 \end{code}
 122
 123
 124