[project @ 2003-10-30 16:01:49 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 6f7fdde..eaa3238 100644 (file)
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -59,7 +59,7 @@ module TcType (
   getClassPredTys_maybe, getClassPredTys, 
   isClassPred, isTyVarClassPred, 
   mkDictTy, tcSplitPredTy_maybe, 
-  isDictTy, tcSplitDFunTy, predTyUnique, 
+  isPredTy, isDictTy, tcSplitDFunTy, predTyUnique, 
   mkClassPred, isInheritablePred, isLinearPred, isIPPred, mkPredName, 
 
   ---------------------------------
@@ -86,7 +86,7 @@ module TcType (
   Kind,        -- Stuff to do with kinds is insensitive to pre/post Tc
   unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds, 
   superBoxity, liftedBoxity, hasMoreBoxityInfo, defaultKind, superKind,
-  isTypeKind, isAnyTypeKind,
+  isTypeKind, isAnyTypeKind, typeCon,
 
   Type, PredType(..), ThetaType, 
   mkForAllTy, mkForAllTys, 
@@ -96,20 +96,21 @@ module TcType (
 
   isUnLiftedType,      -- Source types are always lifted
   isUnboxedTupleType,  -- Ditto
-  isPrimitiveType, isTyVarTy, isPredTy,
+  isPrimitiveType, 
 
   tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
   tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars,
   typeKind, eqKind,
 
-  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta
-  ) where
+  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
 
-#include "HsVersions.h"
+  pprKind, pprParendKind,
+  pprType, pprParendType,
+  pprPred, pprTheta, pprThetaArrow, pprClassPred
 
+  ) where
 
-import {-# SOURCE #-} PprType( pprType )
--- PprType imports TcType so that it can print intelligently
+#include "HsVersions.h"
 
 -- friends:
 import TypeRep         ( Type(..), TyNote(..), funTyCon )  -- friend
@@ -117,7 +118,7 @@ import TypeRep              ( Type(..), TyNote(..), funTyCon )  -- friend
 import Type            (       -- Re-exports
                          tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
                          tyVarsOfTheta, Kind, Type, PredType(..),
-                         ThetaType, unliftedTypeKind,
+                         ThetaType, unliftedTypeKind, typeCon,
                          liftedTypeKind, openTypeKind, mkArrowKind,
                          mkArrowKinds, mkForAllTy, mkForAllTys,
                          defaultKind, isTypeKind, isAnyTypeKind,
@@ -125,7 +126,7 @@ import Type         (       -- Re-exports
                          mkTyConApp, mkGenTyConApp, mkAppTy,
                          mkAppTys, mkSynTy, applyTy, applyTys,
                          mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
-                         mkPredTys, isUnLiftedType, isPredTy,
+                         mkPredTys, isUnLiftedType, 
                          isUnboxedTupleType, isPrimitiveType,
                          splitTyConApp_maybe,
                          tidyTopType, tidyType, tidyPred, tidyTypes,
@@ -133,7 +134,10 @@ import Type                (       -- Re-exports
                          tidyTyVarBndr, tidyOpenTyVar,
                          tidyOpenTyVars, eqKind, 
                          hasMoreBoxityInfo, liftedBoxity,
-                         superBoxity, typeKind, superKind, repType
+                         superBoxity, typeKind, superKind, repType,
+                         pprKind, pprParendKind,
+                         pprType, pprParendType,
+                         pprPred, pprTheta, pprThetaArrow, pprClassPred
                        )
 import TyCon           ( TyCon, isUnLiftedTyCon, tyConUnique )
 import Class           ( Class )
@@ -241,6 +245,10 @@ data TyVarDetails
 
    | InstTv    -- Ditto, but instance decl
 
+   | PatSigTv  -- Scoped type variable, introduced by a pattern
+               -- type signature
+               --      \ x::a -> e
+
    | VanillaTv -- Everything else
 
 isUserTyVar :: TcTyVar -> Bool -- Avoid unifying these if possible
@@ -266,6 +274,7 @@ tyVarBindingInfo tv
     details SigTv     = ptext SLIT("type signature")
     details ClsTv     = ptext SLIT("class declaration")
     details InstTv    = ptext SLIT("instance declaration")
+    details PatSigTv  = ptext SLIT("pattern type signature")
     details VanillaTv = ptext SLIT("//vanilla//")      -- Ditto
 \end{code}
 
@@ -669,6 +678,12 @@ isOverloadedTy (ForAllTy tyvar ty) = isOverloadedTy ty
 isOverloadedTy (FunTy a b)        = isPredTy a
 isOverloadedTy (NoteTy n ty)      = isOverloadedTy ty
 isOverloadedTy _                  = False
+
+isPredTy :: Type -> Bool       -- Belongs in TcType because it does 
+                               -- not look through newtypes, or predtypes (of course)
+isPredTy (NoteTy _ ty) = isPredTy ty
+isPredTy (PredTy sty)  = True
+isPredTy _            = False
 \end{code}
 
 \begin{code}