6 tyVarKind, -- TyVar -> Kind
7 tyVarFlexi, -- GenTyVar flexi -> flexi
11 openAlphaTyVar, openAlphaTyVars,
12 alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
14 -- We also export "environments" keyed off of
15 -- TyVars and "sets" containing TyVars:
17 emptyTyVarEnv, mkTyVarEnv, zipTyVarEnv, addToTyVarEnv, plusTyVarEnv,
18 growTyVarEnvList, isEmptyTyVarEnv, lookupTyVarEnv, delFromTyVarEnv,
20 GenTyVarSet, TyVarSet,
21 emptyTyVarSet, unitTyVarSet, unionTyVarSets, addOneToTyVarSet,
22 unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
23 tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
24 isEmptyTyVarSet, delOneFromTyVarSet
27 #include "HsVersions.h"
30 import Kind ( Kind, mkBoxedTypeKind, mkTypeKind )
33 import UniqSet -- nearly all of it
34 import UniqFM ( emptyUFM, listToUFM, addToUFM, lookupUFM, delFromUFM,
35 plusUFM, sizeUFM, delFromUFM, isNullUFM, UniqFM
37 import BasicTypes ( Unused, unused )
38 import Name ( mkSysLocalName, mkLocalName, Name, NamedThing(..), OccName )
39 import SrcLoc ( noSrcLoc, SrcLoc )
40 import Unique ( initTyVarUnique, incrUnique, Unique, Uniquable(..) )
41 import Util ( zipEqual )
46 data GenTyVar flexi_slot
50 (Maybe Name) -- User name (if any)
51 flexi_slot -- Extra slot used during type and usage
52 -- inference, and to contain usages.
54 type TyVar = GenTyVar Unused
56 tyVarFlexi :: GenTyVar flexi -> flexi
57 tyVarFlexi (TyVar _ _ _ flex) = flex
59 setTyVarFlexi :: GenTyVar flexi1 -> flexi2 -> GenTyVar flexi2
60 setTyVarFlexi (TyVar u k n _) flex = TyVar u k n flex
64 Simple construction and analysis functions
65 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
67 mkTyVar :: Name -> Kind -> TyVar
68 mkTyVar name kind = TyVar (uniqueOf name)
73 mkSysTyVar :: Unique -> Kind -> TyVar
74 mkSysTyVar uniq kind = TyVar uniq
79 tyVarKind :: GenTyVar flexi -> Kind
80 tyVarKind (TyVar _ kind _ _) = kind
82 cloneTyVar :: GenTyVar flexi -> Unique -> GenTyVar flexi
83 cloneTyVar (TyVar _ k n x) u = TyVar u k Nothing x
86 nameTyVar :: GenTyVar flexi -> OccName -> GenTyVar flexi
87 -- Give the TyVar a print-name
88 nameTyVar (TyVar u k n x) occ = TyVar u k (Just (mkLocalName u occ noSrcLoc)) x
92 Fixed collection of type variables
93 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
95 -- openAlphaTyVar is prepared to be instantiated
96 -- to a boxed or unboxed type variable. It's used for the
97 -- result type for "error", so that we can have (error Int# "Help")
98 openAlphaTyVar = TyVar initTyVarUnique mkTypeKind Nothing unused
101 [ TyVar u mkTypeKind Nothing unused
102 | u <- iterate incrUnique initTyVarUnique]
104 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing unused
105 | u <- iterate incrUnique initTyVarUnique]
107 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
115 type TyVarEnv elt = UniqFM elt
117 emptyTyVarEnv :: TyVarEnv a
118 mkTyVarEnv :: [(GenTyVar flexi, a)] -> TyVarEnv a
119 zipTyVarEnv :: [GenTyVar flexi] -> [a] -> TyVarEnv a
120 addToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
121 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
122 isEmptyTyVarEnv :: TyVarEnv a -> Bool
123 lookupTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> Maybe a
124 delFromTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> TyVarEnv a
125 plusTyVarEnv :: TyVarEnv a -> TyVarEnv a -> TyVarEnv a
127 emptyTyVarEnv = emptyUFM
128 mkTyVarEnv = listToUFM
129 addToTyVarEnv = addToUFM
130 lookupTyVarEnv = lookupUFM
131 delFromTyVarEnv = delFromUFM
132 plusTyVarEnv = plusUFM
133 isEmptyTyVarEnv = isNullUFM
135 zipTyVarEnv tyvars tys = listToUFM (zipEqual "zipTyVarEnv" tyvars tys)
136 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
142 type GenTyVarSet flexi = UniqSet (GenTyVar flexi)
143 type TyVarSet = UniqSet TyVar
145 emptyTyVarSet :: GenTyVarSet flexi
146 intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
147 unionTyVarSets :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
148 unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
149 tyVarSetToList :: GenTyVarSet flexi -> [GenTyVar flexi]
150 unitTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
151 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
152 minusTyVarSet :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
153 isEmptyTyVarSet :: GenTyVarSet flexi -> Bool
154 mkTyVarSet :: [GenTyVar flexi] -> GenTyVarSet flexi
155 addOneToTyVarSet :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
156 delOneFromTyVarSet :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
158 emptyTyVarSet = emptyUniqSet
159 unitTyVarSet = unitUniqSet
160 addOneToTyVarSet = addOneToUniqSet
161 delOneFromTyVarSet = delOneFromUniqSet
162 intersectTyVarSets= intersectUniqSets
163 unionTyVarSets = unionUniqSets
164 unionManyTyVarSets= unionManyUniqSets
165 tyVarSetToList = uniqSetToList
166 elementOfTyVarSet = elementOfUniqSet
167 minusTyVarSet = minusUniqSet
168 isEmptyTyVarSet = isEmptyUniqSet
169 mkTyVarSet = mkUniqSet
175 instance Eq (GenTyVar a) where
176 (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
178 instance Ord (GenTyVar a) where
179 compare (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `compare` u2
181 instance Uniquable (GenTyVar a) where
182 uniqueOf (TyVar u _ _ _) = u
184 instance NamedThing (GenTyVar a) where
185 getName (TyVar _ _ (Just n) _) = n
186 getName (TyVar u _ _ _) = mkSysLocalName u SLIT("t") noSrcLoc