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,
  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 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing unused
 101               | u <- iterate incrUnique initTyVarUnique]
 102
 103 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
 104
 105 \end{code}
 106
 107
 108 Environments
 109 ~~~~~~~~~~~~
 110 \begin{code}
 111 type TyVarEnv elt = UniqFM elt
 112
 113 emptyTyVarEnv    :: TyVarEnv a
 114 mkTyVarEnv       :: [(GenTyVar flexi, a)] -> TyVarEnv a
 115 zipTyVarEnv      :: [GenTyVar flexi] -> [a] -> TyVarEnv a
 116 addToTyVarEnv    :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
 117 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
 118 isEmptyTyVarEnv  :: TyVarEnv a -> Bool
 119 lookupTyVarEnv   :: TyVarEnv a -> GenTyVar flexi -> Maybe a
 120 delFromTyVarEnv  :: TyVarEnv a -> GenTyVar flexi -> TyVarEnv a
 121 plusTyVarEnv     :: TyVarEnv a -> TyVarEnv a -> TyVarEnv a
 122
 123 emptyTyVarEnv    = emptyUFM
 124 mkTyVarEnv       = listToUFM
 125 addToTyVarEnv    = addToUFM
 126 lookupTyVarEnv   = lookupUFM
 127 delFromTyVarEnv  = delFromUFM
 128 plusTyVarEnv     = plusUFM
 129 isEmptyTyVarEnv  = isNullUFM
 130
 131 zipTyVarEnv tyvars tys     = listToUFM (zipEqual "zipTyVarEnv" tyvars tys)
 132 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
 133 \end{code}
 134
 135 Sets
 136 ~~~~
 137 \begin{code}
 138 type GenTyVarSet flexi  = UniqSet (GenTyVar flexi)
 139 type TyVarSet           = UniqSet TyVar
 140
 141 emptyTyVarSet     :: GenTyVarSet flexi
 142 intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 143 unionTyVarSets    :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 144 unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
 145 tyVarSetToList    :: GenTyVarSet flexi -> [GenTyVar flexi]
 146 unitTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
 147 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
 148 minusTyVarSet     :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 149 isEmptyTyVarSet   :: GenTyVarSet flexi -> Bool
 150 mkTyVarSet        :: [GenTyVar flexi] -> GenTyVarSet flexi
 151 addOneToTyVarSet  :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
 152 delOneFromTyVarSet :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
 153
 154 emptyTyVarSet     = emptyUniqSet
 155 unitTyVarSet      = unitUniqSet
 156 addOneToTyVarSet  = addOneToUniqSet
 157 delOneFromTyVarSet = delOneFromUniqSet
 158 intersectTyVarSets= intersectUniqSets
 159 unionTyVarSets    = unionUniqSets
 160 unionManyTyVarSets= unionManyUniqSets
 161 tyVarSetToList    = uniqSetToList
 162 elementOfTyVarSet = elementOfUniqSet
 163 minusTyVarSet     = minusUniqSet
 164 isEmptyTyVarSet   = isEmptyUniqSet
 165 mkTyVarSet        = mkUniqSet
 166 \end{code}
 167
 168 Instance delarations
 169 ~~~~~~~~~~~~~~~~~~~~
 170 \begin{code}
 171 instance Eq (GenTyVar a) where
 172     (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
 173
 174 instance Ord (GenTyVar a) where
 175     compare (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `compare` u2
 176
 177 instance Uniquable (GenTyVar a) where
 178     uniqueOf (TyVar u _ _ _) = u
 179
 180 instance NamedThing (GenTyVar a) where
 181     getName (TyVar _ _ (Just n) _) = n
 182     getName (TyVar u _ _        _) = mkSysLocalName u SLIT("t") noSrcLoc
 183 \end{code}