2 #include "HsVersions.h"
5 GenTyVar(..), TyVar(..),
7 getTyVarKind, -- TyVar -> Kind
9 alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
11 -- We also export "environments" keyed off of
12 -- TyVars and "sets" containing TyVars:
14 nullTyVarEnv, mkTyVarEnv, addOneToTyVarEnv,
15 growTyVarEnvList, isNullTyVarEnv, lookupTyVarEnv,
17 GenTyVarSet(..), TyVarSet(..),
18 emptyTyVarSet, singletonTyVarSet, unionTyVarSets,
19 unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
20 tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
24 CHK_Ubiq() -- debugging consistency check
25 import IdLoop -- for paranoia checking
28 import Usage ( GenUsage, Usage(..), usageOmega )
29 import Kind ( Kind, mkBoxedTypeKind )
32 import UniqSet -- nearly all of it
33 import UniqFM ( emptyUFM, listToUFM, addToUFM, lookupUFM,
34 plusUFM, sizeUFM, UniqFM
36 import Maybes ( Maybe(..) )
37 import NameTypes ( ShortName )
38 import Pretty ( Pretty(..), PrettyRep, ppBeside, ppPStr )
39 import PprStyle ( PprStyle )
40 import Outputable ( Outputable(..), NamedThing(..), ExportFlag(..) )
41 import SrcLoc ( mkUnknownSrcLoc, SrcLoc )
42 import Unique ( showUnique, mkAlphaTyVarUnique, Unique )
43 import Util ( panic, Ord3(..) )
47 data GenTyVar flexi_slot
51 (Maybe ShortName) -- User name (if any)
52 flexi_slot -- Extra slot used during type and usage
53 -- inference, and to contain usages.
55 type TyVar = GenTyVar Usage -- Usage slot makes sense only if Kind = Type
59 Simple construction and analysis functions
60 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
62 mkTyVar :: ShortName -> Unique -> Kind -> TyVar
63 mkTyVar name uniq kind = TyVar uniq
68 getTyVarKind :: GenTyVar flexi -> Kind
69 getTyVarKind (TyVar _ kind _ _) = kind
73 Fixed collection of type variables
74 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
76 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
77 | u <- map mkAlphaTyVarUnique [1..] ]
79 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
86 type TyVarEnv elt = UniqFM elt
88 nullTyVarEnv :: TyVarEnv a
89 mkTyVarEnv :: [(GenTyVar flexi, a)] -> TyVarEnv a
90 addOneToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
91 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
92 isNullTyVarEnv :: TyVarEnv a -> Bool
93 lookupTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> Maybe a
95 nullTyVarEnv = emptyUFM
96 mkTyVarEnv = listToUFM
97 addOneToTyVarEnv = addToUFM
98 lookupTyVarEnv = lookupUFM
100 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
101 isNullTyVarEnv env = sizeUFM env == 0
107 type GenTyVarSet flexi = UniqSet (GenTyVar flexi)
108 type TyVarSet = UniqSet TyVar
110 emptyTyVarSet :: GenTyVarSet flexi
111 intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
112 unionTyVarSets :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
113 unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
114 tyVarSetToList :: GenTyVarSet flexi -> [GenTyVar flexi]
115 singletonTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
116 elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
117 minusTyVarSet :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
118 isEmptyTyVarSet :: GenTyVarSet flexi -> Bool
119 mkTyVarSet :: [GenTyVar flexi] -> GenTyVarSet flexi
121 emptyTyVarSet = emptyUniqSet
122 singletonTyVarSet = singletonUniqSet
123 intersectTyVarSets= intersectUniqSets
124 unionTyVarSets = unionUniqSets
125 unionManyTyVarSets= unionManyUniqSets
126 tyVarSetToList = uniqSetToList
127 elementOfTyVarSet = elementOfUniqSet
128 minusTyVarSet = minusUniqSet
129 isEmptyTyVarSet = isEmptyUniqSet
130 mkTyVarSet = mkUniqSet
136 instance Eq (GenTyVar a) where
137 (TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
139 instance Ord3 (GenTyVar a) where
140 cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
142 instance NamedThing (GenTyVar a) where
143 getExportFlag (TyVar _ _ _ _) = NotExported
144 isLocallyDefined (TyVar _ _ _ _) = True
146 getOrigName (TyVar _ _ (Just n) _) = getOrigName n
147 getOrigName (TyVar u _ _ _) = (panic "getOrigName:TyVar",
149 getOccurrenceName (TyVar _ _ (Just n) _) = getOccurrenceName n
150 getOccurrenceName (TyVar u _ _ _) = showUnique u
152 getSrcLoc (TyVar _ _ (Just n) _) = getSrcLoc n
153 getSrcLoc (TyVar _ _ _ _) = mkUnknownSrcLoc
154 fromPreludeCore (TyVar _ _ _ _) = False
156 getItsUnique (TyVar u _ _ _) = u