ghc/compiler/types/TyVar.lhs

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