ghc/compiler/types/TyVar.lhs

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