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