ghc/compiler/types/TyVar.lhs

   1 \begin{code}
   2 #include "HsVersions.h"
   3
   4 module TyVar (
   5         GenTyVar(..), TyVar(..),
   6         mkTyVar,
   7         getTyVarKind,           -- TyVar -> Kind
   8
   9         alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
  10
  11         -- We also export "environments" keyed off of
  12         -- TyVars and "sets" containing TyVars:
  13         TyVarEnv(..),
  14         nullTyVarEnv, mkTyVarEnv, addOneToTyVarEnv,
  15         growTyVarEnvList, isNullTyVarEnv, lookupTyVarEnv,
  16
  17         GenTyVarSet(..), TyVarSet(..),
  18         emptyTyVarSet, singletonTyVarSet, unionTyVarSets,
  19         unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
  20         tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
  21         isEmptyTyVarSet
  22   ) where
  23
  24 CHK_Ubiq()      -- debugging consistency check
  25 import IdLoop   -- for paranoia checking
  26
  27 -- friends
  28 import Usage            ( GenUsage, Usage(..), usageOmega )
  29 import Kind             ( Kind, mkBoxedTypeKind )
  30
  31 -- others
  32 import UniqSet          -- nearly all of it
  33 import UniqFM           ( emptyUFM, listToUFM, addToUFM, lookupUFM,
  34                           plusUFM, sizeUFM, UniqFM
  35                         )
  36 import Maybes           ( Maybe(..) )
  37 import NameTypes        ( ShortName )
  38 import Pretty           ( Pretty(..), PrettyRep, ppBeside, ppPStr )
  39 import PprStyle         ( PprStyle )
  40 import Outputable       ( Outputable(..), NamedThing(..), ExportFlag(..) )
  41 import SrcLoc           ( mkUnknownSrcLoc, SrcLoc )
  42 import Unique           ( showUnique, mkAlphaTyVarUnique, Unique )
  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 ShortName)       -- 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 :: ShortName -> Unique -> Kind -> TyVar
  63 mkTyVar name uniq kind = TyVar  uniq
  64                                 kind
  65                                 (Just name)
  66                                 usageOmega
  67
  68 getTyVarKind :: GenTyVar flexi -> Kind
  69 getTyVarKind (TyVar _ kind _ _) = kind
  70 \end{code}
  71
  72
  73 Fixed collection of type variables
  74 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  75 \begin{code}
  76 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
  77               | u <- map mkAlphaTyVarUnique [1..] ]
  78
  79 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
  80 \end{code}
  81
  82
  83 Environments
  84 ~~~~~~~~~~~~
  85 \begin{code}
  86 type TyVarEnv elt = UniqFM elt
  87
  88 nullTyVarEnv     :: TyVarEnv a
  89 mkTyVarEnv       :: [(GenTyVar flexi, a)] -> TyVarEnv a
  90 addOneToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
  91 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
  92 isNullTyVarEnv   :: TyVarEnv a -> Bool
  93 lookupTyVarEnv   :: TyVarEnv a -> GenTyVar flexi -> Maybe a
  94
  95 nullTyVarEnv     = emptyUFM
  96 mkTyVarEnv       = listToUFM
  97 addOneToTyVarEnv = addToUFM
  98 lookupTyVarEnv   = lookupUFM
  99
 100 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
 101 isNullTyVarEnv   env       = sizeUFM env == 0
 102 \end{code}
 103
 104 Sets
 105 ~~~~
 106 \begin{code}
 107 type GenTyVarSet flexi  = UniqSet (GenTyVar flexi)
 108 type TyVarSet           = UniqSet TyVar
 109
 110 emptyTyVarSet     :: GenTyVarSet flexi
 111 intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 112 unionTyVarSets    :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 113 unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
 114 tyVarSetToList    :: GenTyVarSet flexi -> [GenTyVar flexi]
 115 singletonTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
 116 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
 117 minusTyVarSet     :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 118 isEmptyTyVarSet   :: GenTyVarSet flexi -> Bool
 119 mkTyVarSet        :: [GenTyVar flexi] -> GenTyVarSet flexi
 120
 121 emptyTyVarSet     = emptyUniqSet
 122 singletonTyVarSet = singletonUniqSet
 123 intersectTyVarSets= intersectUniqSets
 124 unionTyVarSets    = unionUniqSets
 125 unionManyTyVarSets= unionManyUniqSets
 126 tyVarSetToList    = uniqSetToList
 127 elementOfTyVarSet = elementOfUniqSet
 128 minusTyVarSet     = minusUniqSet
 129 isEmptyTyVarSet   = isEmptyUniqSet
 130 mkTyVarSet        = mkUniqSet
 131 \end{code}
 132
 133 Instance delarations
 134 ~~~~~~~~~~~~~~~~~~~~
 135 \begin{code}
 136 instance Eq (GenTyVar a) where
 137     (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
 138
 139 instance Ord3 (GenTyVar a) where
 140     cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
 141
 142 instance NamedThing (GenTyVar a) where
 143     getExportFlag       (TyVar _ _ _ _) = NotExported
 144     isLocallyDefined    (TyVar _ _ _ _) = True
 145
 146     getOrigName         (TyVar _ _ (Just n) _) = getOrigName n
 147     getOrigName         (TyVar u _ _        _) = (panic "getOrigName:TyVar",
 148                                                   showUnique u)
 149     getOccurrenceName   (TyVar _ _ (Just n) _) = getOccurrenceName n
 150     getOccurrenceName   (TyVar u _ _        _) = showUnique u
 151
 152     getSrcLoc           (TyVar _ _ (Just n) _) = getSrcLoc n
 153     getSrcLoc           (TyVar _ _ _        _) = mkUnknownSrcLoc
 154     fromPreludeCore     (TyVar _ _ _ _)        = False
 155
 156     getItsUnique        (TyVar u _ _ _)        = u
 157
 158 \end{code}