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