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 --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, delFromUFM, 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 delFromTyVarEnv  :: TyVarEnv a -> GenTyVar flexi -> TyVarEnv a
 111
 112 nullTyVarEnv     = emptyUFM
 113 mkTyVarEnv       = listToUFM
 114 addOneToTyVarEnv = addToUFM
 115 lookupTyVarEnv   = lookupUFM
 116 delFromTyVarEnv  = delFromUFM
 117
 118 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
 119 isNullTyVarEnv   env       = sizeUFM env == 0
 120 \end{code}
 121
 122 Sets
 123 ~~~~
 124 \begin{code}
 125 type GenTyVarSet flexi  = UniqSet (GenTyVar flexi)
 126 type TyVarSet           = UniqSet TyVar
 127
 128 emptyTyVarSet     :: GenTyVarSet flexi
 129 intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 130 unionTyVarSets    :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 131 unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
 132 tyVarSetToList    :: GenTyVarSet flexi -> [GenTyVar flexi]
 133 unitTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
 134 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
 135 minusTyVarSet     :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 136 isEmptyTyVarSet   :: GenTyVarSet flexi -> Bool
 137 mkTyVarSet        :: [GenTyVar flexi] -> GenTyVarSet flexi
 138
 139 emptyTyVarSet     = emptyUniqSet
 140 unitTyVarSet = unitUniqSet
 141 intersectTyVarSets= intersectUniqSets
 142 unionTyVarSets    = unionUniqSets
 143 unionManyTyVarSets= unionManyUniqSets
 144 tyVarSetToList    = uniqSetToList
 145 elementOfTyVarSet = elementOfUniqSet
 146 minusTyVarSet     = minusUniqSet
 147 isEmptyTyVarSet   = isEmptyUniqSet
 148 mkTyVarSet        = mkUniqSet
 149 \end{code}
 150
 151 Instance delarations
 152 ~~~~~~~~~~~~~~~~~~~~
 153 \begin{code}
 154 instance Eq (GenTyVar a) where
 155     (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
 156
 157 instance Ord3 (GenTyVar a) where
 158     cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
 159
 160 instance Uniquable (GenTyVar a) where
 161     uniqueOf (TyVar u _ _ _) = u
 162
 163 instance NamedThing (GenTyVar a) where
 164     getName (TyVar _ _ (Just n) _) = n
 165     getName (TyVar u _ _        _) = mkLocalName u (showUnique u) True{-emph uniq-} mkUnknownSrcLoc
 166 \end{code}