2 #include "HsVersions.h"
5 GenTyVar(..), 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,
19 GenTyVarSet(..), 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, 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, UniqFM
38 import Maybes ( Maybe(..) )
39 import Name ( mkLocalName, changeUnique, Name, RdrName(..) )
40 import Pretty ( Pretty(..), PrettyRep, ppBeside, ppPStr )
41 import PprStyle ( PprStyle )
42 --import Outputable ( Outputable(..), NamedThing(..), ExportFlag(..) )
43 import SrcLoc ( mkUnknownSrcLoc, SrcLoc )
44 import Unique ( showUnique, mkAlphaTyVarUnique, Unique )
45 import Util ( panic, Ord3(..) )
49 data GenTyVar flexi_slot
53 (Maybe Name) -- User name (if any)
54 flexi_slot -- Extra slot used during type and usage
55 -- inference, and to contain usages.
57 type TyVar = GenTyVar Usage -- Usage slot makes sense only if Kind = Type
61 Simple construction and analysis functions
62 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
64 mkTyVar :: Name -> Unique -> Kind -> TyVar
65 mkTyVar name uniq kind = TyVar uniq
67 (Just (changeUnique name uniq))
70 tyVarKind :: GenTyVar flexi -> Kind
71 tyVarKind (TyVar _ kind _ _) = kind
73 cloneTyVar :: GenTyVar flexi -> Unique -> GenTyVar flexi
74 cloneTyVar (TyVar _ k n x) u = TyVar u k n x
78 Fixed collection of type variables
79 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
81 -- openAlphaTyVar is prepared to be instantiated
82 -- to a boxed or unboxed type variable. It's used for the
83 -- result type for "error", so that we can have (error Int# "Help")
84 openAlphaTyVar = TyVar (mkAlphaTyVarUnique 1) mkTypeKind Nothing usageOmega
86 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
87 | u <- map mkAlphaTyVarUnique [2..] ]
89 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
97 type TyVarEnv elt = UniqFM elt
99 nullTyVarEnv :: TyVarEnv a
100 mkTyVarEnv :: [(GenTyVar flexi, a)] -> TyVarEnv a
101 addOneToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
102 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
103 isNullTyVarEnv :: TyVarEnv a -> Bool
104 lookupTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> Maybe a
106 nullTyVarEnv = emptyUFM
107 mkTyVarEnv = listToUFM
108 addOneToTyVarEnv = addToUFM
109 lookupTyVarEnv = lookupUFM
111 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
112 isNullTyVarEnv env = sizeUFM env == 0
118 type GenTyVarSet flexi = UniqSet (GenTyVar flexi)
119 type TyVarSet = UniqSet TyVar
121 emptyTyVarSet :: GenTyVarSet flexi
122 intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
123 unionTyVarSets :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
124 unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
125 tyVarSetToList :: GenTyVarSet flexi -> [GenTyVar flexi]
126 unitTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
127 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
128 minusTyVarSet :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
129 isEmptyTyVarSet :: GenTyVarSet flexi -> Bool
130 mkTyVarSet :: [GenTyVar flexi] -> GenTyVarSet flexi
132 emptyTyVarSet = emptyUniqSet
133 unitTyVarSet = unitUniqSet
134 intersectTyVarSets= intersectUniqSets
135 unionTyVarSets = unionUniqSets
136 unionManyTyVarSets= unionManyUniqSets
137 tyVarSetToList = uniqSetToList
138 elementOfTyVarSet = elementOfUniqSet
139 minusTyVarSet = minusUniqSet
140 isEmptyTyVarSet = isEmptyUniqSet
141 mkTyVarSet = mkUniqSet
147 instance Eq (GenTyVar a) where
148 (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
150 instance Ord3 (GenTyVar a) where
151 cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
153 instance Uniquable (GenTyVar a) where
154 uniqueOf (TyVar u _ _ _) = u
156 instance NamedThing (GenTyVar a) where
157 getName (TyVar _ _ (Just n) _) = n
158 getName (TyVar u _ _ _) = mkLocalName u (showUnique u) True{-emph uniq-} mkUnknownSrcLoc