ghc/compiler/types/TyVar.lhs

   1 \begin{code}
   2 #include "HsVersions.h"
   3
   4 module TyVar (
   5         GenTyVar(..), TyVar(..),
   6         mkTyVar,
   7         getTyVarKind,           -- TyVar -> Kind
   8
   9         alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
  10
  11         -- We also export "environments" keyed off of
  12         -- TyVars and "sets" containing TyVars:
  13         TyVarEnv(..),
  14         nullTyVarEnv, mkTyVarEnv, addOneToTyVarEnv,
  15         growTyVarEnvList, isNullTyVarEnv, lookupTyVarEnv,
  16
  17         GenTyVarSet(..), TyVarSet(..),
  18         emptyTyVarSet, singletonTyVarSet, unionTyVarSets, tyVarListToSet,
  19         tyVarSetToList, elementOfTyVarSet, minusTyVarSet, isEmptyTyVarSet
  20   ) where
  21
  22 CHK_Ubiq()      -- debugging consistency check
  23 import IdLoop   -- for paranoia checking
  24
  25 -- friends
  26 import Usage            ( GenUsage, Usage(..), usageOmega )
  27 import Kind             ( Kind, mkBoxedTypeKind )
  28
  29 -- others
  30 import UniqSet          ( uniqSetToList, emptyUniqSet, singletonUniqSet, minusUniqSet,
  31                           unionUniqSets, elementOfUniqSet, isEmptyUniqSet, mkUniqSet,
  32                           UniqSet(..) )
  33 import UniqFM           ( emptyUFM, listToUFM, addToUFM, lookupUFM,
  34                           plusUFM, sizeUFM, UniqFM )
  35 import Maybes           ( Maybe(..) )
  36 import NameTypes        ( ShortName )
  37 import Pretty           ( Pretty(..), PrettyRep, ppBeside, ppPStr )
  38 import PprStyle         ( PprStyle )
  39 import Outputable       ( Outputable(..), NamedThing(..), ExportFlag(..) )
  40 import SrcLoc           ( mkUnknownSrcLoc, SrcLoc )
  41 import Unique           ( showUnique, mkAlphaTyVarUnique, Unique )
  42 import Util             ( panic, Ord3(..) )
  43 \end{code}
  44
  45 \begin{code}
  46 data GenTyVar flexi_slot
  47   = TyVar
  48         Unique
  49         Kind
  50         (Maybe ShortName)       -- User name (if any)
  51         flexi_slot              -- Extra slot used during type and usage
  52                                 -- inference, and to contain usages.
  53
  54 type TyVar = GenTyVar Usage     -- Usage slot makes sense only if Kind = Type
  55 \end{code}
  56
  57
  58 Simple construction and analysis functions
  59 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  60 \begin{code}
  61 mkTyVar :: ShortName -> Unique -> Kind -> TyVar
  62 mkTyVar name uniq kind = TyVar  uniq
  63                                 kind
  64                                 (Just name)
  65                                 usageOmega
  66
  67 getTyVarKind :: GenTyVar flexi -> Kind
  68 getTyVarKind (TyVar _ kind _ _) = kind
  69 \end{code}
  70
  71
  72 Fixed collection of type variables
  73 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  74 \begin{code}
  75 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
  76               | u <- map mkAlphaTyVarUnique [1..] ]
  77
  78 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
  79 \end{code}
  80
  81
  82 Environments
  83 ~~~~~~~~~~~~
  84 \begin{code}
  85 type TyVarEnv elt = UniqFM elt
  86
  87 nullTyVarEnv     :: TyVarEnv a
  88 mkTyVarEnv       :: [(GenTyVar flexi, a)] -> TyVarEnv a
  89 addOneToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
  90 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
  91 isNullTyVarEnv   :: TyVarEnv a -> Bool
  92 lookupTyVarEnv   :: TyVarEnv a -> GenTyVar flexi -> Maybe a
  93
  94 nullTyVarEnv     = emptyUFM
  95 mkTyVarEnv       = listToUFM
  96 addOneToTyVarEnv = addToUFM
  97 lookupTyVarEnv   = lookupUFM
  98
  99 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
 100 isNullTyVarEnv   env       = sizeUFM env == 0
 101 \end{code}
 102
 103 Sets
 104 ~~~~
 105 \begin{code}
 106 type GenTyVarSet flexi  = UniqSet (GenTyVar flexi)
 107 type TyVarSet           = UniqSet TyVar
 108
 109 emptyTyVarSet     :: GenTyVarSet flexi
 110 unionTyVarSets    :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 111 tyVarSetToList    :: GenTyVarSet flexi -> [GenTyVar flexi]
 112 singletonTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
 113 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
 114 minusTyVarSet     :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 115 isEmptyTyVarSet   :: GenTyVarSet flexi -> Bool
 116 tyVarListToSet    :: [GenTyVar flexi] -> GenTyVarSet flexi
 117
 118 emptyTyVarSet     = emptyUniqSet
 119 singletonTyVarSet = singletonUniqSet
 120 unionTyVarSets    = unionUniqSets
 121 tyVarSetToList    = uniqSetToList
 122 elementOfTyVarSet = elementOfUniqSet
 123 minusTyVarSet     = minusUniqSet
 124 isEmptyTyVarSet   = isEmptyUniqSet
 125 tyVarListToSet    = mkUniqSet
 126 \end{code}
 127
 128 Instance delarations
 129 ~~~~~~~~~~~~~~~~~~~~
 130 \begin{code}
 131 instance Eq (GenTyVar a) where
 132     (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
 133
 134 instance Ord3 (GenTyVar a) where
 135     cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
 136
 137 instance NamedThing (GenTyVar a) where
 138     getExportFlag       (TyVar _ _ _ _) = NotExported
 139     isLocallyDefined    (TyVar _ _ _ _) = True
 140
 141     getOrigName         (TyVar _ _ (Just n) _) = getOrigName n
 142     getOrigName         (TyVar u _ _        _) = (panic "getOrigName:TyVar",
 143                                                   showUnique u)
 144     getOccurrenceName   (TyVar _ _ (Just n) _) = getOccurrenceName n
 145     getOccurrenceName   (TyVar u _ _        _) = showUnique u
 146
 147     getSrcLoc           (TyVar _ _ (Just n) _) = getSrcLoc n
 148     getSrcLoc           (TyVar _ _ _        _) = mkUnknownSrcLoc
 149     fromPreludeCore     (TyVar _ _ _ _)        = False
 150
 151     getItsUnique        (TyVar u _ _ _)        = u
 152
 153 \end{code}