From a6d49b70aa6d95dca040715216218b90c6fd1b92 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Sat, 26 Jul 1997 03:40:25 +0000
Subject: [PATCH] [project @ 1997-07-26 03:40:25 by sof] moved TcIdBndr and
TcIdOcc to here from TcHsSyn
---
ghc/compiler/typecheck/TcType.lhs | 35 +++++++++++++++++++++++++------
1 file changed, 29 insertions(+), 6 deletions(-)
diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index b6c236238fe4..0af7c447ecfd 100644
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -2,15 +2,15 @@
#include "HsVersions.h"
module TcType (
-
+ SYN_IE(TcIdBndr), TcIdOcc(..),
+
+ -----------------------------------------
SYN_IE(TcTyVar),
+ SYN_IE(TcTyVarSet),
newTcTyVar,
newTyVarTy, -- Kind -> NF_TcM s (TcType s)
newTyVarTys, -- Int -> Kind -> NF_TcM s [TcType s]
-
- SYN_IE(TcTyVarSet),
-
-----------------------------------------
SYN_IE(TcType), TcMaybe(..),
SYN_IE(TcTauType), SYN_IE(TcThetaType), SYN_IE(TcRhoType),
@@ -48,11 +48,12 @@ import TyVar ( SYN_IE(TyVar), GenTyVar(..), SYN_IE(TyVarSet), SYN_IE(GenTyVarSet
nullTyVarEnv, mkTyVarEnv,
tyVarSetToList
)
+import PprType ( GenType, GenTyVar ) -- Instances only
-- others:
import Class ( GenClass, SYN_IE(Class) )
import TyCon ( isFunTyCon )
-import Id ( idType, SYN_IE(Id) )
+import Id ( idType, GenId, SYN_IE(Id) )
import Kind ( Kind )
import TcKind ( TcKind )
import TcMonad
@@ -61,9 +62,11 @@ import Usage ( SYN_IE(Usage), GenUsage, SYN_IE(UVar), duffUsage )
import TysPrim ( voidTy )
IMP_Ubiq()
+import Name ( NamedThing(..) )
import Unique ( Unique )
import UniqFM ( UniqFM )
import Maybes ( assocMaybe )
+import Outputable ( Outputable(..) )
import Util ( zipEqual, nOfThem, panic{-, pprPanic, pprTrace ToDo:rm-} )
\end{code}
@@ -72,6 +75,26 @@ import Util ( zipEqual, nOfThem, panic{-, pprPanic, pprTrace ToDo:rm-} )
Data types
~~~~~~~~~~
+\begin{code}
+type TcIdBndr s = GenId (TcType s) -- Binders are all TcTypes
+data TcIdOcc s = TcId (TcIdBndr s) -- Bindees may be either
+ | RealId Id
+
+instance Eq (TcIdOcc s) where
+ (TcId id1) == (TcId id2) = id1 == id2
+ (RealId id1) == (RealId id2) = id1 == id2
+ _ == _ = False
+
+instance Outputable (TcIdOcc s) where
+ ppr sty (TcId id) = ppr sty id
+ ppr sty (RealId id) = ppr sty id
+
+instance NamedThing (TcIdOcc s) where
+ getName (TcId id) = getName id
+ getName (RealId id) = getName id
+\end{code}
+
+
\begin{code}
type TcType s = GenType (TcTyVar s) UVar -- Used during typechecker
-- Invariant on ForAllTy in TcTypes:
@@ -383,7 +406,7 @@ zonkTcTyVar :: TcTyVar s -> NF_TcM s (TcType s)
zonkTcTyVar tyvar
= tcReadTyVar tyvar `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
- BoundTo ty@(TyVarTy tyvar') -> returnNF_Tc ty
+ BoundTo ty@(TyVarTy tyvar') -> returnNF_Tc ty -- tcReadTyVar never returns a bound tyvar
BoundTo other -> zonkTcType other
other -> returnNF_Tc (TyVarTy tyvar)
--
GitLab