[project @ 2003-02-12 15:01:31 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcType.lhs

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 29997cd..d604b07 100644 (file)
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -16,6 +16,10 @@ is the principal client.
 \begin{code}
 module TcType (
   --------------------------------
+  -- TyThing
+  TyThing(..), -- instance NamedThing
+
+  --------------------------------
   -- Types 
   TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType, 
   TcTyVar, TcTyVarSet, TcKind, 
@@ -96,7 +100,7 @@ module TcType (
 
   tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
   tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars,
-  typeKind, eqKind, eqUsage,
+  typeKind, eqKind,
 
   tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta
   ) where
@@ -111,22 +115,30 @@ import {-# SOURCE #-} PprType( pprType )
 import TypeRep         ( Type(..), TyNote(..), funTyCon )  -- friend
 
 import Type            (       -- Re-exports
-                         tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-                         Kind, Type, SourceType(..), PredType, ThetaType, 
-                         unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
-                         mkForAllTy, mkForAllTys, defaultKind, isTypeKind, isAnyTypeKind,
+                         tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
+                         tyVarsOfTheta, Kind, Type, SourceType(..),
+                         PredType, ThetaType, unliftedTypeKind,
+                         liftedTypeKind, openTypeKind, mkArrowKind,
+                         mkArrowKinds, mkForAllTy, mkForAllTys,
+                         defaultKind, isTypeKind, isAnyTypeKind,
                          mkFunTy, mkFunTys, zipFunTys, isTyVarTy,
-                         mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
-                         mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
-                         isUnLiftedType, isUnboxedTupleType, isPrimitiveType,
+                         mkTyConApp, mkGenTyConApp, mkAppTy,
+                         mkAppTys, mkSynTy, applyTy, applyTys,
+                         mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
+                         mkPredTys, isUnLiftedType,
+                         isUnboxedTupleType, isPrimitiveType,
                          splitNewType_maybe, splitTyConApp_maybe,
-                         tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
-                         tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars, eqKind, eqUsage,
-                         hasMoreBoxityInfo, liftedBoxity, superBoxity, typeKind, superKind
+                         tidyTopType, tidyType, tidyPred, tidyTypes,
+                         tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
+                         tidyTyVarBndr, tidyOpenTyVar,
+                         tidyOpenTyVars, eqKind, 
+                         hasMoreBoxityInfo, liftedBoxity,
+                         superBoxity, typeKind, superKind, repType
                        )
+import DataCon         ( DataCon )
 import TyCon           ( TyCon, isUnLiftedTyCon )
 import Class           ( classHasFDs, Class )
-import Var             ( TyVar, tyVarKind, isMutTyVar, mutTyVarDetails )
+import Var             ( TyVar, Id, tyVarKind, isMutTyVar, mutTyVarDetails )
 import ForeignCall     ( Safety, playSafe )
 import VarEnv
 import VarSet
@@ -149,6 +161,26 @@ import Outputable
 
 %************************************************************************
 %*                                                                     *
+                       TyThing
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+data TyThing = AnId     Id
+            | ADataCon DataCon
+            | ATyCon   TyCon
+            | AClass   Class
+
+instance NamedThing TyThing where
+  getName (AnId id)     = getName id
+  getName (ATyCon tc)   = getName tc
+  getName (AClass cl)   = getName cl
+  getName (ADataCon dc) = getName dc
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
 \subsection{Types}
 %*                                                                     *
 %************************************************************************
@@ -442,8 +474,7 @@ The type of a method for class C is always of the form:
 where sig_ty is the type given by the method's signature, and thus in general
 is a ForallTy.  At the point that splitMethodTy is called, it is expected
 that the outer Forall has already been stripped off.  splitMethodTy then
-returns (C a1..an, sig_ty') where sig_ty' is sig_ty with any Notes or
-Usages stripped off.
+returns (C a1..an, sig_ty') where sig_ty' is sig_ty with any Notes stripped off.
 
 \begin{code}
 tcSplitMethodTy :: Type -> (PredType, Type)
@@ -824,9 +855,8 @@ checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
        -- Non-recursive ones are transparent to splitTyConApp,
        -- but recursive ones aren't; hence the splitNewType_maybe
 checkRepTyCon check_tc ty 
-  | Just ty'    <- splitNewType_maybe ty  = checkRepTyCon check_tc ty'
-  | Just (tc,_) <- splitTyConApp_maybe ty = check_tc tc
-  | otherwise                            = False
+  | Just (tc,_) <- splitTyConApp_maybe (repType ty) = check_tc tc
+  | otherwise                                      = False
 \end{code}
 
 ----------------------------------------------