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