2 #include "HsVersions.h"
5 GenTyVar(..), SYN_IE(TyVar),
7 tyVarKind, -- TyVar -> Kind
11 alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
13 -- We also export "environments" keyed off of
14 -- TyVars and "sets" containing TyVars:
16 nullTyVarEnv, mkTyVarEnv, addOneToTyVarEnv,
17 growTyVarEnvList, isNullTyVarEnv, lookupTyVarEnv, delFromTyVarEnv,
19 SYN_IE(GenTyVarSet), SYN_IE(TyVarSet),
20 emptyTyVarSet, unitTyVarSet, unionTyVarSets,
21 unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
22 tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
26 CHK_Ubiq() -- debugging consistency check
27 IMPORT_DELOOPER(IdLoop) -- for paranoia checking
30 import Usage ( GenUsage, SYN_IE(Usage), usageOmega )
31 import Kind ( Kind, mkBoxedTypeKind, mkTypeKind )
34 import UniqSet -- nearly all of it
35 import UniqFM ( emptyUFM, listToUFM, addToUFM, lookupUFM,
36 plusUFM, sizeUFM, delFromUFM, UniqFM
38 import Name ( mkLocalName, changeUnique, Name, RdrName(..) )
39 import Pretty ( SYN_IE(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(..) )
48 data GenTyVar flexi_slot
52 (Maybe Name) -- User name (if any)
53 flexi_slot -- Extra slot used during type and usage
54 -- inference, and to contain usages.
56 type TyVar = GenTyVar Usage -- Usage slot makes sense only if Kind = Type
60 Simple construction and analysis functions
61 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
63 mkTyVar :: Name -> Kind -> TyVar
64 mkTyVar name kind = TyVar (uniqueOf name)
69 mkSysTyVar :: Unique -> Kind -> TyVar
70 mkSysTyVar uniq kind = TyVar uniq
75 tyVarKind :: GenTyVar flexi -> Kind
76 tyVarKind (TyVar _ kind _ _) = kind
78 cloneTyVar :: GenTyVar flexi -> Unique -> GenTyVar flexi
79 cloneTyVar (TyVar _ k n x) u = TyVar u k n x
83 Fixed collection of type variables
84 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
86 -- openAlphaTyVar is prepared to be instantiated
87 -- to a boxed or unboxed type variable. It's used for the
88 -- result type for "error", so that we can have (error Int# "Help")
89 openAlphaTyVar = TyVar (mkAlphaTyVarUnique 1) mkTypeKind Nothing usageOmega
91 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
92 | u <- map mkAlphaTyVarUnique [2..] ]
94 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
102 type TyVarEnv elt = UniqFM elt
104 nullTyVarEnv :: TyVarEnv a
105 mkTyVarEnv :: [(GenTyVar flexi, a)] -> TyVarEnv a
106 addOneToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
107 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
108 isNullTyVarEnv :: TyVarEnv a -> Bool
109 lookupTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> Maybe a
110 delFromTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> TyVarEnv a
112 nullTyVarEnv = emptyUFM
113 mkTyVarEnv = listToUFM
114 addOneToTyVarEnv = addToUFM
115 lookupTyVarEnv = lookupUFM
116 delFromTyVarEnv = delFromUFM
118 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
119 isNullTyVarEnv env = sizeUFM env == 0
125 type GenTyVarSet flexi = UniqSet (GenTyVar flexi)
126 type TyVarSet = UniqSet TyVar
128 emptyTyVarSet :: GenTyVarSet flexi
129 intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
130 unionTyVarSets :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
131 unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
132 tyVarSetToList :: GenTyVarSet flexi -> [GenTyVar flexi]
133 unitTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
134 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
135 minusTyVarSet :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
136 isEmptyTyVarSet :: GenTyVarSet flexi -> Bool
137 mkTyVarSet :: [GenTyVar flexi] -> GenTyVarSet flexi
139 emptyTyVarSet = emptyUniqSet
140 unitTyVarSet = unitUniqSet
141 intersectTyVarSets= intersectUniqSets
142 unionTyVarSets = unionUniqSets
143 unionManyTyVarSets= unionManyUniqSets
144 tyVarSetToList = uniqSetToList
145 elementOfTyVarSet = elementOfUniqSet
146 minusTyVarSet = minusUniqSet
147 isEmptyTyVarSet = isEmptyUniqSet
148 mkTyVarSet = mkUniqSet
154 instance Eq (GenTyVar a) where
155 (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
157 instance Ord3 (GenTyVar a) where
158 cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
160 instance Uniquable (GenTyVar a) where
161 uniqueOf (TyVar u _ _ _) = u
163 instance NamedThing (GenTyVar a) where
164 getName (TyVar _ _ (Just n) _) = n
165 getName (TyVar u _ _ _) = mkLocalName u (showUnique u) True{-emph uniq-} mkUnknownSrcLoc