\begin{code}
-#include "HsVersions.h"
-
module TyVar (
- GenTyVar(..), TyVar(..),
- mkTyVar,
- getTyVarKind, -- TyVar -> Kind
- cloneTyVar,
+ GenTyVar(..), TyVar,
+ mkTyVar, mkSysTyVar,
+ tyVarKind, -- TyVar -> Kind
+ tyVarFlexi, -- GenTyVar flexi -> flexi
+ setTyVarFlexi,
+ cloneTyVar, nameTyVar,
+
+ openAlphaTyVar,
alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
-- We also export "environments" keyed off of
-- TyVars and "sets" containing TyVars:
- TyVarEnv(..),
- nullTyVarEnv, mkTyVarEnv, addOneToTyVarEnv,
- growTyVarEnvList, isNullTyVarEnv, lookupTyVarEnv,
+ TyVarEnv,
+ emptyTyVarEnv, mkTyVarEnv, zipTyVarEnv, addToTyVarEnv, plusTyVarEnv,
+ growTyVarEnvList, isEmptyTyVarEnv, lookupTyVarEnv, delFromTyVarEnv,
- GenTyVarSet(..), TyVarSet(..),
- emptyTyVarSet, unitTyVarSet, unionTyVarSets,
+ GenTyVarSet, TyVarSet,
+ emptyTyVarSet, unitTyVarSet, unionTyVarSets, addOneToTyVarSet,
unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
- isEmptyTyVarSet
+ isEmptyTyVarSet, delOneFromTyVarSet
) where
-CHK_Ubiq() -- debugging consistency check
-import IdLoop -- for paranoia checking
+#include "HsVersions.h"
-- friends
-import Usage ( GenUsage, Usage(..), usageOmega )
-import Kind ( Kind, mkBoxedTypeKind )
+import Kind ( Kind, mkBoxedTypeKind, mkTypeKind )
-- others
import UniqSet -- nearly all of it
-import UniqFM ( emptyUFM, listToUFM, addToUFM, lookupUFM,
- plusUFM, sizeUFM, UniqFM
+import UniqFM ( emptyUFM, listToUFM, addToUFM, lookupUFM, delFromUFM,
+ plusUFM, sizeUFM, delFromUFM, isNullUFM, UniqFM
)
-import Maybes ( Maybe(..) )
-import NameTypes ( ShortName )
-import Pretty ( Pretty(..), PrettyRep, ppBeside, ppPStr )
-import PprStyle ( PprStyle )
-import Outputable ( Outputable(..), NamedThing(..), ExportFlag(..) )
-import SrcLoc ( mkUnknownSrcLoc, SrcLoc )
-import Unique ( showUnique, mkAlphaTyVarUnique, Unique )
-import Util ( panic, Ord3(..) )
+import BasicTypes ( Unused, unused )
+import Name ( mkSysLocalName, mkLocalName, Name, NamedThing(..), OccName )
+import SrcLoc ( noSrcLoc, SrcLoc )
+import Unique ( mkAlphaTyVarUnique, Unique, Uniquable(..) )
+import Util ( zipEqual )
+import Outputable
\end{code}
\begin{code}
= TyVar
Unique
Kind
- (Maybe ShortName) -- User name (if any)
+ (Maybe Name) -- User name (if any)
flexi_slot -- Extra slot used during type and usage
-- inference, and to contain usages.
-type TyVar = GenTyVar Usage -- Usage slot makes sense only if Kind = Type
+type TyVar = GenTyVar Unused
+
+tyVarFlexi :: GenTyVar flexi -> flexi
+tyVarFlexi (TyVar _ _ _ flex) = flex
+
+setTyVarFlexi :: GenTyVar flexi1 -> flexi2 -> GenTyVar flexi2
+setTyVarFlexi (TyVar u k n _) flex = TyVar u k n flex
\end{code}
Simple construction and analysis functions
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\begin{code}
-mkTyVar :: ShortName -> Unique -> Kind -> TyVar
-mkTyVar name uniq kind = TyVar uniq
- kind
- (Just name)
- usageOmega
+mkTyVar :: Name -> Kind -> TyVar
+mkTyVar name kind = TyVar (uniqueOf name)
+ kind
+ (Just name)
+ unused
-getTyVarKind :: GenTyVar flexi -> Kind
-getTyVarKind (TyVar _ kind _ _) = kind
+mkSysTyVar :: Unique -> Kind -> TyVar
+mkSysTyVar uniq kind = TyVar uniq
+ kind
+ Nothing
+ unused
+
+tyVarKind :: GenTyVar flexi -> Kind
+tyVarKind (TyVar _ kind _ _) = kind
cloneTyVar :: GenTyVar flexi -> Unique -> GenTyVar flexi
-cloneTyVar (TyVar _ k n x) u = TyVar u k n x
+cloneTyVar (TyVar _ k n x) u = TyVar u k Nothing x
+ -- Zaps its name
+
+nameTyVar :: GenTyVar flexi -> OccName -> GenTyVar flexi
+ -- Give the TyVar a print-name
+nameTyVar (TyVar u k n x) occ = TyVar u k (Just (mkLocalName u occ noSrcLoc)) x
\end{code}
Fixed collection of type variables
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\begin{code}
-alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
- | u <- map mkAlphaTyVarUnique [1..] ]
+ -- openAlphaTyVar is prepared to be instantiated
+ -- to a boxed or unboxed type variable. It's used for the
+ -- result type for "error", so that we can have (error Int# "Help")
+openAlphaTyVar = TyVar (mkAlphaTyVarUnique 1) mkTypeKind Nothing unused
+
+alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing unused
+ | u <- map mkAlphaTyVarUnique [2..] ]
(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
+
\end{code}
\begin{code}
type TyVarEnv elt = UniqFM elt
-nullTyVarEnv :: TyVarEnv a
+emptyTyVarEnv :: TyVarEnv a
mkTyVarEnv :: [(GenTyVar flexi, a)] -> TyVarEnv a
-addOneToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
+zipTyVarEnv :: [GenTyVar flexi] -> [a] -> TyVarEnv a
+addToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
-isNullTyVarEnv :: TyVarEnv a -> Bool
+isEmptyTyVarEnv :: TyVarEnv a -> Bool
lookupTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> Maybe a
+delFromTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> TyVarEnv a
+plusTyVarEnv :: TyVarEnv a -> TyVarEnv a -> TyVarEnv a
-nullTyVarEnv = emptyUFM
+emptyTyVarEnv = emptyUFM
mkTyVarEnv = listToUFM
-addOneToTyVarEnv = addToUFM
+addToTyVarEnv = addToUFM
lookupTyVarEnv = lookupUFM
+delFromTyVarEnv = delFromUFM
+plusTyVarEnv = plusUFM
+isEmptyTyVarEnv = isNullUFM
+zipTyVarEnv tyvars tys = listToUFM (zipEqual "zipTyVarEnv" tyvars tys)
growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
-isNullTyVarEnv env = sizeUFM env == 0
\end{code}
Sets
minusTyVarSet :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
isEmptyTyVarSet :: GenTyVarSet flexi -> Bool
mkTyVarSet :: [GenTyVar flexi] -> GenTyVarSet flexi
+addOneToTyVarSet :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
+delOneFromTyVarSet :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
emptyTyVarSet = emptyUniqSet
-unitTyVarSet = unitUniqSet
+unitTyVarSet = unitUniqSet
+addOneToTyVarSet = addOneToUniqSet
+delOneFromTyVarSet = delOneFromUniqSet
intersectTyVarSets= intersectUniqSets
unionTyVarSets = unionUniqSets
unionManyTyVarSets= unionManyUniqSets
instance Eq (GenTyVar a) where
(TyVar u1 _ _ _) == (TyVar u2 _ _ _) = u1 == u2
-instance Ord3 (GenTyVar a) where
- cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
-
-instance NamedThing (GenTyVar a) where
- getExportFlag (TyVar _ _ _ _) = NotExported
- isLocallyDefined (TyVar _ _ _ _) = True
+instance Ord (GenTyVar a) where
+ compare (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `compare` u2
- getOrigName (TyVar _ _ (Just n) _) = getOrigName n
- getOrigName (TyVar u _ _ _) = (panic "getOrigName:TyVar",
- showUnique u)
- getOccurrenceName (TyVar _ _ (Just n) _) = getOccurrenceName n
- getOccurrenceName (TyVar u _ _ _) = showUnique u
-
- getSrcLoc (TyVar _ _ (Just n) _) = getSrcLoc n
- getSrcLoc (TyVar _ _ _ _) = mkUnknownSrcLoc
- fromPreludeCore (TyVar _ _ _ _) = False
-
- getItsUnique (TyVar u _ _ _) = u
+instance Uniquable (GenTyVar a) where
+ uniqueOf (TyVar u _ _ _) = u
+instance NamedThing (GenTyVar a) where
+ getName (TyVar _ _ (Just n) _) = n
+ getName (TyVar u _ _ _) = mkSysLocalName u SLIT("t") noSrcLoc
\end{code}