ghc/compiler/types/TyVar.lhs

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