ghc/compiler/types/Usage.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[Usage]{The @Usage@ datatype}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module Usage (
  10         GenUsage, Usage(..), UVar(..), UVarEnv(..),
  11         usageOmega, pprUVar, duffUsage,
  12         nullUVarEnv, mkUVarEnv, addOneToUVarEnv,
  13         growUVarEnvList, isNullUVarEnv, lookupUVarEnv,
  14         eqUVar, eqUsage
  15 ) where
  16
  17 import Ubiq
  18 import Pretty   ( Pretty(..), PrettyRep, ppPStr, ppBeside )
  19 import UniqFM   ( emptyUFM, listToUFM, addToUFM, lookupUFM,
  20                   plusUFM, sizeUFM, UniqFM )
  21 import Unique   ( Unique{-instances-} )
  22 \end{code}
  23
  24 \begin{code}
  25 data GenUsage uvar
  26   = UsageVar uvar
  27   | UsageOne
  28   | UsageOmega
  29
  30 type UVar  = Unique
  31 type Usage = GenUsage UVar
  32
  33 usageOmega = UsageOmega
  34
  35 duffUsage :: GenUsage uvar
  36 duffUsage = error "Usage of non-Type kind doesn't make sense"
  37 \end{code}
  38
  39 %************************************************************************
  40 %*                                                                      *
  41 \subsection{Environments}
  42 %*                                                                      *
  43 %************************************************************************
  44
  45 \begin{code}
  46 type UVarEnv a = UniqFM a
  47
  48 nullUVarEnv     :: UVarEnv a
  49 mkUVarEnv       :: [(UVar, a)] -> UVarEnv a
  50 addOneToUVarEnv :: UVarEnv a -> UVar -> a -> UVarEnv a
  51 growUVarEnvList :: UVarEnv a -> [(UVar, a)] -> UVarEnv a
  52 isNullUVarEnv   :: UVarEnv a -> Bool
  53 lookupUVarEnv   :: UVarEnv a -> UVar -> Maybe a
  54
  55 nullUVarEnv     = emptyUFM
  56 mkUVarEnv       = listToUFM
  57 addOneToUVarEnv = addToUFM
  58 lookupUVarEnv   = lookupUFM
  59
  60 growUVarEnvList env pairs = plusUFM env (listToUFM pairs)
  61 isNullUVarEnv   env       = sizeUFM env == 0
  62 \end{code}
  63
  64 %************************************************************************
  65 %*                                                                      *
  66 \subsection{Equality on usages}
  67 %*                                                                      *
  68 %************************************************************************
  69
  70 Equaltity (with respect to an environment mapping usage variables
  71 to equivalent usage variables).
  72
  73 \begin{code}
  74 eqUVar :: UVarEnv UVar -> UVar -> UVar -> Bool
  75 eqUVar uve u1 u2 =
  76   u1 == u2 ||
  77   case lookupUVarEnv uve u1 of
  78     Just u -> u == u2
  79     Nothing -> False
  80
  81 eqUsage :: UVarEnv UVar -> Usage -> Usage -> Bool
  82 eqUsage uve (UsageVar u1) (UsageVar u2) = eqUVar uve u1 u2
  83 eqUsage uve UsageOne      UsageOne   = True
  84 eqUsage uve UsageOmega    UsageOmega = True
  85 eqUsage _ _ _ = False
  86 \end{code}
  87
  88 %************************************************************************
  89 %*                                                                      *
  90 \subsection{Instances}
  91 %*                                                                      *
  92 %************************************************************************
  93
  94 \begin{code}
  95 instance Eq u => Eq (GenUsage u) where
  96   (UsageVar u1) == (UsageVar u2) = u1 == u2
  97   UsageOne      == UsageOne      = True
  98   UsageOmega    == UsageOmega    = True
  99   _             == _             = False
 100 \end{code}
 101
 102 \begin{code}
 103 instance Outputable uvar => Outputable (GenUsage uvar) where
 104     ppr sty UsageOne     = ppPStr SLIT("UsageOne")
 105     ppr sty UsageOmega   = ppPStr SLIT("UsageOmega")
 106     ppr sty (UsageVar u) = pprUVar sty u
 107
 108 pprUVar sty u = ppBeside (ppPStr SLIT("u")) (ppr sty u)
 109 \end{code}