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, nameTyVar,
   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, mkLocalName, Name, NamedThing(..), OccName )
  38 import Pretty           ( Doc, (<>), ptext )
  39 import Outputable       ( PprStyle(..), Outputable(..) )
  40 import SrcLoc           ( noSrcLoc, SrcLoc )
  41 import Unique           ( mkAlphaTyVarUnique, Unique, Uniquable(..) )
  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 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 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 :: Name -> Kind -> TyVar
  62 mkTyVar name kind = TyVar  (uniqueOf name)
  63                            kind
  64                            (Just name)
  65                            usageOmega
  66
  67 mkSysTyVar :: Unique -> Kind -> TyVar
  68 mkSysTyVar uniq kind = TyVar uniq
  69                              kind
  70                              Nothing
  71                              usageOmega
  72
  73 tyVarKind :: GenTyVar flexi -> Kind
  74 tyVarKind (TyVar _ kind _ _) = kind
  75
  76 cloneTyVar :: GenTyVar flexi -> Unique -> GenTyVar flexi
  77 cloneTyVar (TyVar _ k n x) u = TyVar u k n x
  78         -- Dodgy: doesn't (yet) change the unique in the Name)
  79
  80 nameTyVar :: GenTyVar flexi -> OccName -> GenTyVar flexi
  81         -- Give the TyVar a print-name
  82 nameTyVar (TyVar u k n x) occ = TyVar u k (Just (mkLocalName u occ noSrcLoc)) x
  83 \end{code}
  84
  85
  86 Fixed collection of type variables
  87 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  88 \begin{code}
  89         -- openAlphaTyVar is prepared to be instantiated
  90         -- to a boxed or unboxed type variable.  It's used for the
  91         -- result type for "error", so that we can have (error Int# "Help")
  92 openAlphaTyVar = TyVar (mkAlphaTyVarUnique 1) mkTypeKind Nothing usageOmega
  93
  94 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
  95               | u <- map mkAlphaTyVarUnique [2..] ]
  96
  97 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
  98
  99 \end{code}
 100
 101
 102 Environments
 103 ~~~~~~~~~~~~
 104 \begin{code}
 105 type TyVarEnv elt = UniqFM elt
 106
 107 nullTyVarEnv     :: TyVarEnv a
 108 mkTyVarEnv       :: [(GenTyVar flexi, a)] -> TyVarEnv a
 109 addOneToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
 110 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
 111 isNullTyVarEnv   :: TyVarEnv a -> Bool
 112 lookupTyVarEnv   :: TyVarEnv a -> GenTyVar flexi -> Maybe a
 113 delFromTyVarEnv  :: TyVarEnv a -> GenTyVar flexi -> TyVarEnv a
 114
 115 nullTyVarEnv     = emptyUFM
 116 mkTyVarEnv       = listToUFM
 117 addOneToTyVarEnv = addToUFM
 118 lookupTyVarEnv   = lookupUFM
 119 delFromTyVarEnv  = delFromUFM
 120
 121 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
 122 isNullTyVarEnv   env       = sizeUFM env == 0
 123 \end{code}
 124
 125 Sets
 126 ~~~~
 127 \begin{code}
 128 type GenTyVarSet flexi  = UniqSet (GenTyVar flexi)
 129 type TyVarSet           = UniqSet TyVar
 130
 131 emptyTyVarSet     :: GenTyVarSet flexi
 132 intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 133 unionTyVarSets    :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 134 unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
 135 tyVarSetToList    :: GenTyVarSet flexi -> [GenTyVar flexi]
 136 unitTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
 137 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
 138 minusTyVarSet     :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 139 isEmptyTyVarSet   :: GenTyVarSet flexi -> Bool
 140 mkTyVarSet        :: [GenTyVar flexi] -> GenTyVarSet flexi
 141
 142 emptyTyVarSet     = emptyUniqSet
 143 unitTyVarSet = unitUniqSet
 144 intersectTyVarSets= intersectUniqSets
 145 unionTyVarSets    = unionUniqSets
 146 unionManyTyVarSets= unionManyUniqSets
 147 tyVarSetToList    = uniqSetToList
 148 elementOfTyVarSet = elementOfUniqSet
 149 minusTyVarSet     = minusUniqSet
 150 isEmptyTyVarSet   = isEmptyUniqSet
 151 mkTyVarSet        = mkUniqSet
 152 \end{code}
 153
 154 Instance delarations
 155 ~~~~~~~~~~~~~~~~~~~~
 156 \begin{code}
 157 instance Eq (GenTyVar a) where
 158     (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
 159
 160 instance Ord3 (GenTyVar a) where
 161     cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
 162
 163 instance Uniquable (GenTyVar a) where
 164     uniqueOf (TyVar u _ _ _) = u
 165
 166 instance NamedThing (GenTyVar a) where
 167     getName (TyVar _ _ (Just n) _) = n
 168     getName (TyVar u _ _        _) = mkSysLocalName u SLIT("t") noSrcLoc
 169 \end{code}