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