2 #include "HsVersions.h"
5 GenTyVar(..), TyVar(..),
7 tyVarKind, -- TyVar -> Kind
10 alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
12 -- We also export "environments" keyed off of
13 -- TyVars and "sets" containing TyVars:
15 nullTyVarEnv, mkTyVarEnv, addOneToTyVarEnv,
16 growTyVarEnvList, isNullTyVarEnv, lookupTyVarEnv,
18 GenTyVarSet(..), TyVarSet(..),
19 emptyTyVarSet, unitTyVarSet, unionTyVarSets,
20 unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
21 tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
25 CHK_Ubiq() -- debugging consistency check
26 import IdLoop -- for paranoia checking
29 import Usage ( GenUsage, Usage(..), usageOmega )
30 import Kind ( Kind, mkBoxedTypeKind )
33 import UniqSet -- nearly all of it
34 import UniqFM ( emptyUFM, listToUFM, addToUFM, lookupUFM,
35 plusUFM, sizeUFM, UniqFM
37 import Maybes ( Maybe(..) )
38 import Name ( mkLocalName, 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(..) )
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 -> Unique -> Kind -> TyVar
64 mkTyVar name uniq kind = TyVar uniq
69 tyVarKind :: GenTyVar flexi -> Kind
70 tyVarKind (TyVar _ kind _ _) = kind
72 cloneTyVar :: GenTyVar flexi -> Unique -> GenTyVar flexi
73 cloneTyVar (TyVar _ k n x) u = TyVar u k n x
77 Fixed collection of type variables
78 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
80 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
81 | u <- map mkAlphaTyVarUnique [1..] ]
83 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
90 type TyVarEnv elt = UniqFM elt
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
99 nullTyVarEnv = emptyUFM
100 mkTyVarEnv = listToUFM
101 addOneToTyVarEnv = addToUFM
102 lookupTyVarEnv = lookupUFM
104 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
105 isNullTyVarEnv env = sizeUFM env == 0
111 type GenTyVarSet flexi = UniqSet (GenTyVar flexi)
112 type TyVarSet = UniqSet TyVar
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
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
140 instance Eq (GenTyVar a) where
141 (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
143 instance Ord3 (GenTyVar a) where
144 cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
146 instance Uniquable (GenTyVar a) where
147 uniqueOf (TyVar u _ _ _) = u
149 instance NamedThing (GenTyVar a) where
150 getName (TyVar _ _ (Just n) _) = n
151 getName (TyVar u _ _ _) = mkLocalName u (showUnique u) mkUnknownSrcLoc