#include "HsVersions.h"
module TyVar (
- GenTyVar(..), TyVar(..),
- mkTyVar,
- getTyVarKind, -- TyVar -> Kind
+ GenTyVar(..), SYN_IE(TyVar),
+ mkTyVar, mkSysTyVar,
+ tyVarKind, -- TyVar -> Kind
+ cloneTyVar,
+ openAlphaTyVar,
alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
-- We also export "environments" keyed off of
-- TyVars and "sets" containing TyVars:
- TyVarEnv(..),
+ SYN_IE(TyVarEnv),
nullTyVarEnv, mkTyVarEnv, addOneToTyVarEnv,
- growTyVarEnvList, isNullTyVarEnv, lookupTyVarEnv,
+ growTyVarEnvList, isNullTyVarEnv, lookupTyVarEnv, delFromTyVarEnv,
- GenTyVarSet(..), TyVarSet(..),
- emptyTyVarSet, singletonTyVarSet, unionTyVarSets, tyVarListToSet,
- tyVarSetToList, elementOfTyVarSet, minusTyVarSet, isEmptyTyVarSet
+ SYN_IE(GenTyVarSet), SYN_IE(TyVarSet),
+ emptyTyVarSet, unitTyVarSet, unionTyVarSets,
+ unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
+ tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
+ isEmptyTyVarSet
) where
CHK_Ubiq() -- debugging consistency check
-import IdLoop -- for paranoia checking
+--IMPORT_DELOOPER(IdLoop) -- for paranoia checking
-- friends
-import Usage ( GenUsage, Usage(..), usageOmega )
-import Kind ( Kind, mkBoxedTypeKind )
+import Usage ( GenUsage, SYN_IE(Usage), usageOmega )
+import Kind ( Kind, mkBoxedTypeKind, mkTypeKind )
-- others
-import UniqSet ( uniqSetToList, emptyUniqSet, singletonUniqSet, minusUniqSet,
- unionUniqSets, elementOfUniqSet, isEmptyUniqSet, mkUniqSet,
- UniqSet(..) )
+import UniqSet -- nearly all of it
import UniqFM ( emptyUFM, listToUFM, addToUFM, lookupUFM,
- plusUFM, sizeUFM, UniqFM )
-import Maybes ( Maybe(..) )
-import NameTypes ( ShortName )
-import Pretty ( Pretty(..), PrettyRep, ppBeside, ppPStr )
+ plusUFM, sizeUFM, delFromUFM, UniqFM
+ )
+import Name ( mkLocalName, changeUnique, Name, RdrName(..) )
+import Pretty ( SYN_IE(Pretty), PrettyRep, ppBeside, ppPStr )
import PprStyle ( PprStyle )
-import Outputable ( Outputable(..), NamedThing(..), ExportFlag(..) )
+--import Outputable ( Outputable(..), NamedThing(..), ExportFlag(..) )
import SrcLoc ( mkUnknownSrcLoc, SrcLoc )
import Unique ( showUnique, mkAlphaTyVarUnique, Unique )
import Util ( panic, Ord3(..) )
= 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.
Simple construction and analysis functions
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\begin{code}
-mkTyVar :: ShortName -> Unique -> Kind -> TyVar
-mkTyVar name uniq kind = TyVar uniq
- kind
- (Just name)
- usageOmega
-
-getTyVarKind :: GenTyVar flexi -> Kind
-getTyVarKind (TyVar _ kind _ _) = kind
+mkTyVar :: Name -> Kind -> TyVar
+mkTyVar name kind = TyVar (uniqueOf name)
+ kind
+ (Just name)
+ usageOmega
+
+mkSysTyVar :: Unique -> Kind -> TyVar
+mkSysTyVar uniq kind = TyVar uniq
+ kind
+ Nothing
+ usageOmega
+
+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
\end{code}
Fixed collection of type variables
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\begin{code}
+ -- 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 usageOmega
+
alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
- | u <- map mkAlphaTyVarUnique [1..] ]
+ | u <- map mkAlphaTyVarUnique [2..] ]
(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
+
\end{code}
growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
isNullTyVarEnv :: TyVarEnv a -> Bool
lookupTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> Maybe a
+delFromTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> TyVarEnv a
nullTyVarEnv = emptyUFM
mkTyVarEnv = listToUFM
addOneToTyVarEnv = addToUFM
lookupTyVarEnv = lookupUFM
+delFromTyVarEnv = delFromUFM
growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
isNullTyVarEnv env = sizeUFM env == 0
type TyVarSet = UniqSet TyVar
emptyTyVarSet :: GenTyVarSet flexi
+intersectTyVarSets:: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
unionTyVarSets :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
+unionManyTyVarSets:: [GenTyVarSet flexi] -> GenTyVarSet flexi
tyVarSetToList :: GenTyVarSet flexi -> [GenTyVar flexi]
-singletonTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
+unitTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi
elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
minusTyVarSet :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
isEmptyTyVarSet :: GenTyVarSet flexi -> Bool
-tyVarListToSet :: [GenTyVar flexi] -> GenTyVarSet flexi
+mkTyVarSet :: [GenTyVar flexi] -> GenTyVarSet flexi
emptyTyVarSet = emptyUniqSet
-singletonTyVarSet = singletonUniqSet
+unitTyVarSet = unitUniqSet
+intersectTyVarSets= intersectUniqSets
unionTyVarSets = unionUniqSets
+unionManyTyVarSets= unionManyUniqSets
tyVarSetToList = uniqSetToList
elementOfTyVarSet = elementOfUniqSet
minusTyVarSet = minusUniqSet
isEmptyTyVarSet = isEmptyUniqSet
-tyVarListToSet = mkUniqSet
+mkTyVarSet = mkUniqSet
\end{code}
Instance delarations
instance Ord3 (GenTyVar a) where
cmp (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `cmp` u2
-instance NamedThing (GenTyVar a) where
- getExportFlag (TyVar _ _ _ _) = NotExported
- isLocallyDefined (TyVar _ _ _ _) = True
-
- 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 _ _ _) = mkLocalName u (showUnique u) True{-emph uniq-} mkUnknownSrcLoc
\end{code}