\begin{code}
-#include "HsVersions.h"
-
module TyVar (
- GenTyVar(..), TyVar(..),
- mkTyVar,
- tyVarKind, -- 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_DELOOPER(IdLoop) -- for paranoia checking
+#include "HsVersions.h"
-- friends
-import Usage ( GenUsage, Usage(..), usageOmega )
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 Name ( mkLocalName, changeUnique, Name, RdrName(..) )
-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 ( initTyVarUnique, incrUnique, Unique, Uniquable(..) )
+import Util ( zipEqual )
+import Outputable
\end{code}
\begin{code}
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 :: Name -> Unique -> Kind -> TyVar
-mkTyVar name uniq kind = TyVar uniq
- kind
- (Just (changeUnique name uniq))
- usageOmega
+mkTyVar :: Name -> Kind -> TyVar
+mkTyVar name kind = TyVar (uniqueOf name)
+ kind
+ (Just name)
+ unused
+
+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}
-- 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
+openAlphaTyVar = TyVar initTyVarUnique mkTypeKind Nothing unused
-alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing usageOmega
- | u <- map mkAlphaTyVarUnique [2..] ]
+alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing unused
+ | u <- iterate incrUnique initTyVarUnique]
(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
\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 Ord (GenTyVar a) where
+ compare (TyVar u1 _ _ _) (TyVar u2 _ _ _) = u1 `compare` u2
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
+ getName (TyVar u _ _ _) = mkSysLocalName u SLIT("t") noSrcLoc
\end{code}
projects / ghc-hetmet.git / blobdiff