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