6 tyVarKind, -- TyVar -> Kind
7 tyVarFlexi, -- GenTyVar flexi -> flexi
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
100 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing unused
101 | u <- iterate incrUnique initTyVarUnique]
103 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
111 type TyVarEnv elt = UniqFM elt
113 emptyTyVarEnv :: TyVarEnv a
114 mkTyVarEnv :: [(GenTyVar flexi, a)] -> TyVarEnv a
115 zipTyVarEnv :: [GenTyVar flexi] -> [a] -> TyVarEnv a
116 addToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
117 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
118 isEmptyTyVarEnv :: TyVarEnv a -> Bool
119 lookupTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> Maybe a
120 delFromTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> TyVarEnv a
121 plusTyVarEnv :: TyVarEnv a -> TyVarEnv a -> TyVarEnv a
123 emptyTyVarEnv = emptyUFM
124 mkTyVarEnv = listToUFM
125 addToTyVarEnv = addToUFM
126 lookupTyVarEnv = lookupUFM
127 delFromTyVarEnv = delFromUFM
128 plusTyVarEnv = plusUFM
129 isEmptyTyVarEnv = isNullUFM
131 zipTyVarEnv tyvars tys = listToUFM (zipEqual "zipTyVarEnv" tyvars tys)
132 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
138 type GenTyVarSet flexi = UniqSet (GenTyVar flexi)
139 type TyVarSet = UniqSet TyVar
141 emptyTyVarSet :: GenTyVarSet flexi
142 intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
143 unionTyVarSets :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
144 unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
145 tyVarSetToList :: GenTyVarSet flexi -> [GenTyVar flexi]
146 unitTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
147 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
148 minusTyVarSet :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
149 isEmptyTyVarSet :: GenTyVarSet flexi -> Bool
150 mkTyVarSet :: [GenTyVar flexi] -> GenTyVarSet flexi
151 addOneToTyVarSet :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
152 delOneFromTyVarSet :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
154 emptyTyVarSet = emptyUniqSet
155 unitTyVarSet = unitUniqSet
156 addOneToTyVarSet = addOneToUniqSet
157 delOneFromTyVarSet = delOneFromUniqSet
158 intersectTyVarSets= intersectUniqSets
159 unionTyVarSets = unionUniqSets
160 unionManyTyVarSets= unionManyUniqSets
161 tyVarSetToList = uniqSetToList
162 elementOfTyVarSet = elementOfUniqSet
163 minusTyVarSet = minusUniqSet
164 isEmptyTyVarSet = isEmptyUniqSet
165 mkTyVarSet = mkUniqSet
171 instance Eq (GenTyVar a) where
172 (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
174 instance Ord (GenTyVar a) where
175 compare (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `compare` u2
177 instance Uniquable (GenTyVar a) where
178 uniqueOf (TyVar u _ _ _) = u
180 instance NamedThing (GenTyVar a) where
181 getName (TyVar _ _ (Just n) _) = n
182 getName (TyVar u _ _ _) = mkSysLocalName u SLIT("t") noSrcLoc