ghc/compiler/types/TyVar.lhs

   1 \begin{code}
   2 module TyVar (
   3         GenTyVar(..), TyVar,
   4
   5         mkTyVar, mkSysTyVar,
   6         tyVarKind,              -- TyVar -> Kind
   7         cloneTyVar, nameTyVar,
   8
   9         openAlphaTyVar,
  10         alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
  11
  12         -- We also export "environments" keyed off of
  13         -- TyVars and "sets" containing TyVars:
  14         TyVarEnv,
  15         emptyTyVarEnv, mkTyVarEnv, zipTyVarEnv, addToTyVarEnv, plusTyVarEnv,
  16         growTyVarEnvList, isEmptyTyVarEnv, lookupTyVarEnv, delFromTyVarEnv,
  17
  18         GenTyVarSet, TyVarSet,
  19         emptyTyVarSet, unitTyVarSet, unionTyVarSets,
  20         unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
  21         tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
  22         isEmptyTyVarSet
  23   ) where
  24
  25 #include "HsVersions.h"
  26
  27 -- friends
  28 import Kind             ( Kind, mkBoxedTypeKind, mkTypeKind )
  29
  30 -- others
  31 import UniqSet          -- nearly all of it
  32 import UniqFM           ( emptyUFM, listToUFM, addToUFM, lookupUFM,
  33                           plusUFM, sizeUFM, delFromUFM, UniqFM
  34                         )
  35 import BasicTypes       ( Unused, unused )
  36 import Name             ( mkSysLocalName, mkLocalName, Name, NamedThing(..), OccName )
  37 import SrcLoc           ( noSrcLoc, SrcLoc )
  38 import Unique           ( mkAlphaTyVarUnique, Unique, Uniquable(..) )
  39 import Util             ( zipEqual )
  40 import Outputable
  41 \end{code}
  42
  43 \begin{code}
  44 data GenTyVar flexi_slot
  45   = TyVar
  46         Unique
  47         Kind
  48         (Maybe Name)            -- User name (if any)
  49         flexi_slot              -- Extra slot used during type and usage
  50                                 -- inference, and to contain usages.
  51
  52 type TyVar   = GenTyVar Unused
  53 \end{code}
  54
  55
  56 Simple construction and analysis functions
  57 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  58 \begin{code}
  59 mkTyVar :: Name -> Kind -> TyVar
  60 mkTyVar name kind = TyVar  (uniqueOf name)
  61                            kind
  62                            (Just name)
  63                            unused
  64
  65 mkSysTyVar :: Unique -> Kind -> TyVar
  66 mkSysTyVar uniq kind = TyVar uniq
  67                              kind
  68                              Nothing
  69                              unused
  70
  71 tyVarKind :: GenTyVar flexi -> Kind
  72 tyVarKind (TyVar _ kind _ _) = kind
  73
  74 cloneTyVar :: GenTyVar flexi -> Unique -> GenTyVar flexi
  75 cloneTyVar (TyVar _ k n x) u = TyVar u k Nothing x
  76         -- Zaps its name
  77
  78 nameTyVar :: GenTyVar flexi -> OccName -> GenTyVar flexi
  79         -- Give the TyVar a print-name
  80 nameTyVar (TyVar u k n x) occ = TyVar u k (Just (mkLocalName u occ noSrcLoc)) x
  81 \end{code}
  82
  83
  84 Fixed collection of type variables
  85 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  86 \begin{code}
  87         -- openAlphaTyVar is prepared to be instantiated
  88         -- to a boxed or unboxed type variable.  It's used for the
  89         -- result type for "error", so that we can have (error Int# "Help")
  90 openAlphaTyVar = TyVar (mkAlphaTyVarUnique 1) mkTypeKind Nothing unused
  91
  92 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing unused
  93               | u <- map mkAlphaTyVarUnique [2..] ]
  94
  95 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
  96
  97 \end{code}
  98
  99
 100 Environments
 101 ~~~~~~~~~~~~
 102 \begin{code}
 103 type TyVarEnv elt = UniqFM elt
 104
 105 emptyTyVarEnv    :: TyVarEnv a
 106 mkTyVarEnv       :: [(GenTyVar flexi, a)] -> TyVarEnv a
 107 zipTyVarEnv      :: [GenTyVar flexi] -> [a] -> TyVarEnv a
 108 addToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
 109 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
 110 isEmptyTyVarEnv  :: TyVarEnv a -> Bool
 111 lookupTyVarEnv   :: TyVarEnv a -> GenTyVar flexi -> Maybe a
 112 delFromTyVarEnv  :: TyVarEnv a -> GenTyVar flexi -> TyVarEnv a
 113 plusTyVarEnv     :: TyVarEnv a -> TyVarEnv a -> TyVarEnv a
 114
 115 emptyTyVarEnv    = emptyUFM
 116 mkTyVarEnv       = listToUFM
 117 addToTyVarEnv    = addToUFM
 118 lookupTyVarEnv   = lookupUFM
 119 delFromTyVarEnv  = delFromUFM
 120 plusTyVarEnv     = plusUFM
 121
 122 zipTyVarEnv tyvars tys     = listToUFM (zipEqual "zipTyVarEnv" tyvars tys)
 123 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
 124 isEmptyTyVarEnv   env      = sizeUFM env == 0
 125 \end{code}
 126
 127 Sets
 128 ~~~~
 129 \begin{code}
 130 type GenTyVarSet flexi  = UniqSet (GenTyVar flexi)
 131 type TyVarSet           = UniqSet TyVar
 132
 133 emptyTyVarSet     :: GenTyVarSet flexi
 134 intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 135 unionTyVarSets    :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 136 unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
 137 tyVarSetToList    :: GenTyVarSet flexi -> [GenTyVar flexi]
 138 unitTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
 139 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
 140 minusTyVarSet     :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 141 isEmptyTyVarSet   :: GenTyVarSet flexi -> Bool
 142 mkTyVarSet        :: [GenTyVar flexi] -> GenTyVarSet flexi
 143
 144 emptyTyVarSet     = emptyUniqSet
 145 unitTyVarSet = unitUniqSet
 146 intersectTyVarSets= intersectUniqSets
 147 unionTyVarSets    = unionUniqSets
 148 unionManyTyVarSets= unionManyUniqSets
 149 tyVarSetToList    = uniqSetToList
 150 elementOfTyVarSet = elementOfUniqSet
 151 minusTyVarSet     = minusUniqSet
 152 isEmptyTyVarSet   = isEmptyUniqSet
 153 mkTyVarSet        = mkUniqSet
 154 \end{code}
 155
 156 Instance delarations
 157 ~~~~~~~~~~~~~~~~~~~~
 158 \begin{code}
 159 instance Eq (GenTyVar a) where
 160     (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
 161
 162 instance Ord (GenTyVar a) where
 163     compare (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `compare` u2
 164
 165 instance Uniquable (GenTyVar a) where
 166     uniqueOf (TyVar u _ _ _) = u
 167
 168 instance NamedThing (GenTyVar a) where
 169     getName (TyVar _ _ (Just n) _) = n
 170     getName (TyVar u _ _        _) = mkSysLocalName u SLIT("t") noSrcLoc
 171 \end{code}